VBA File Search PDF and Open - search all directories on network drive

[Supes77]

Hi All

I work in an accounts team, where we store scanned PDF batches of financial transactions ( in this case scanned Accounts Payable invoices).

They are stored in directories on a network drive. e.g.:

//Network Name/Accounts Payable/Scanning/2012/01JAN etc

The files look like this "798653.pdf"

I have a macro below working that searches a specific directory (in this case I am telling it to look in 3 different spots, based on a populated URL/hyperlink in the spreadsheet, it then opens the PDF.

The user knows the "date" of the batch they are searching for, so the spreadsheet will generate a file path from the 2 inputs "798653" & "1/1/2012". It will create 2 alternate paths also, 1 month prior and after.

I'd like to eliminate the date, and have it search all directories within //Network Name/Accounts Payable/Scanning/ for any file name containing "798653"



Thanks Guys

<code>

Sub APBatchSearch()


    Dim BatchNumber As String
    Dim BatchURL As String
    Dim BatchURL2 As String
    Dim BatchURL3 As String
    Dim eScriptObject As Object


    ActiveSheet.Calculate
        
    BatchNumber = Range("APSscanBatchNumber")
    BatchURL = Range("BatchURL")
    BatchURL2 = Range("BatchURL2")
    BatchURL3 = Range("BatchURL3")
    
    Set eScriptObject = CreateObject("Scripting.FileSystemObject")
        If eScriptObject.FileExists(BatchURL & BatchNumber & ".pdf") Then
            ThisWorkbook.FollowHyperlink Address:=BatchURL & BatchNumber & ".pdf", NewWindow:=True
        Else
            If eScriptObject.FileExists(BatchURL2 & BatchNumber & ".pdf") Then
                 ThisWorkbook.FollowHyperlink Address:=BatchURL2 & BatchNumber & ".pdf", NewWindow:=True
            Else
                 If eScriptObject.FileExists(BatchURL3 & BatchNumber & ".pdf") Then
                    ThisWorkbook.FollowHyperlink Address:=BatchURL3 & BatchNumber & ".pdf", NewWindow:=True
                                      
                Else: MsgBox ("File Not Found")


                End If
             End If
        End If
End Sub

</code>

 

[Worf]

Hi

See if this example is useful:

Sub SearchDirs()


    Dim mp$, sst$
    sst = "798"     ' desired string
    mp = "c:\Accounts Payable\Scanning\"   ' root directory
    RecursiveDir mp, sst


End Sub


Sub RecursiveDir(ByVal CurrDir$, st$)
    Dim Dirs$(), NumDirs&, FileName$, PathAndName$, i&


'   Make sure path ends in backslash
    If Right(CurrDir, 1) <> "\" Then CurrDir = CurrDir & "\"
   
    FileName = Dir(CurrDir & "*.*", vbDirectory)    ' get files
    Do While Len(FileName) <> 0
      If Left(FileName, 1) <> "." Then 'Current dir
        PathAndName = CurrDir & FileName
        If (GetAttr(PathAndName) And vbDirectory) = vbDirectory Then
          'store found directories
           ReDim Preserve Dirs(0 To NumDirs) As String
           Dirs(NumDirs) = PathAndName
           NumDirs = NumDirs + 1
        Else
          'search for desired string
          If InStr(FileName, st) <> 0 Then _
            ThisWorkbook.FollowHyperlink Address:=PathAndName, NewWindow:=True
        End If
    End If
        FileName = Dir()
    Loop
    ' Process the found directories, recursively
    For i = 0 To NumDirs - 1
        RecursiveDir Dirs(i), st
    Next i
End Sub