Include SubFolders When Looking For The Existence of A File

[Ark68]

I'm using this code check to see if a particular file (a PDF file) exists within a folder.

dpath = "D:\WSOP 2020\Permits\"
nfn = Target.Value & ".pdf"
strFile = dpath & nfn
'Stop
If FileExists(strFile) Then
     MsgBox "Exists."
     Exit Sub
End If

Function FileExists(filePath As String) As Boolean
    Dim TestStr As String
    TestStr = ""
    On Error Resume Next
    Debug.Print filePath
    TestStr = Dir(filePath)
    On Error GoTo 0
    If TestStr = "" Then
        FileExists = False
    Else
        FileExists = True
    End If
End Function

The only problem with this, is it's not searching the folders that are within the folder. It only checks the main folder but none of the subfolders. What must I do to also check the subfolders?
Once the file is located, since it's a PDF, how can I use VBA to open it?

 

[Ark68]

So, I'm working through the code that GWteb provided in the link in post 4. It's taken me a bit to actually figure how things are working but I think I'm halfway there. I'm trying to adapt it so that unlike the original thread of the link, I'm not looping through to list the files and their respective paths. All I need to do is find a matching file within the folders, get the filename and path, and open the file eventually.

This is what I came up with:

Public Sub ListFiles()

    Dim sPathSource As String 

    With ActiveSheet
        sPathSource = "D:\WSOP 2020\Permits\"
        ftf = "Permit#R2685.pdf"
    End With

    Call GetFiles(ftf, sPathSource) 
End Sub

Public Sub GetFiles(ByVal ftf As String, ByVal sPathSource As String) 

    Dim FSO As Object, oRoot As Object, oFile As Object, oFolder As Object
    Dim hstfile As String
    Dim hstpath As String
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(sPathSource) Then 
        Set oRoot = FSO.GetFolder(sPathSource)
        For Each oFile In oRoot.Files
            hstfile = oFile.Name
            hstpath = oFile.ParentFolder.Path
            If ftf = oFile.Name Then 'a match
                MsgBox hstfile & " resides in " & hstpath
                Exit Sub
            End If
        Next oFile
        DoEvents
        For Each oFolder In oRoot.SubFolders
            Debug.Print oFolder
            Debug.Print oRoot
            Call GetFiles(ftf, oFolder.Path) 
        Next oFolder
    End If
End Sub
End Sub

This is producing the results expected, however, when their is success, I can't exit the sub. It wants to continue to go through all the remaining folders. I understand why ... that was the purpose of the original code to locate and display all their paths. But once I find a match, it can stop.

 

[xenou]

You may test this variation (I believe it amounts to a depth first search...)...

Public Sub FindFile()

    Dim RootFolder As String
    Dim FileToSearchFor As String
    Dim FSO As Object

    With ActiveSheet
        RootFolder = "C:\myTemp"
        FileToSearchFor = "fileC.txt"
    End With

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Debug.Print GetFiles(FSO, RootFolder, FileToSearchFor)

End Sub

Public Function GetFiles(ByVal FSO As Object, ByVal FolderToSearchIn As String, ByVal FileToSearchFor As String) As String

    Dim oFile As Object
    Dim oFolder As Object
    Dim oSubFolder As Object
    
    If FSO.FolderExists(FolderToSearchIn) Then
        
        '// Search in Current Folder
        Set oFolder = FSO.GetFolder(FolderToSearchIn)
        For Each oFile In oFolder.Files
            If LCase(oFile.Name) = LCase(FileToSearchFor) Then
                GetFiles = oFile.Path
                Exit Function
            End If
        Next oFile
        
        '// If not found, continue searching in subfolders
        For Each oSubFolder In oFolder.subfolders
            GetFiles = GetFiles(FSO, oSubFolder.Path, FileToSearchFor)
            If GetFiles <> "" Then
                Exit Function
            End If
        Next oSubFolder
    End If

End Function

 

[Ark68]

Xenou, my apologies for taking so long to acknowledge your latest contribution. I took some time away from this project over the holidays and am now back at it. Thank you!
But I'm a bit concerned that I don't know how to use the results.

When I step through my code, the GetFiles function is called, and when the file is found, the debug.print statement does display the full path of the file. I need to take this and use it to open that file. If it doesn't find a file, I need to report that the file isn't found.

This is the code I'm using to call the function ...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim RootFolder As String
    Dim FileToSearchFor As String
    Dim FSO As Object

    Cancel = True
   
    'select permit number to view permit
    If Not Intersect(Target, ws_master.Columns(3)) Is Nothing Then
        If Target.Value = "" Then Exit Sub
        pernum = Target.Value
        ui1 = MsgBox("Do you wish to view this permit?", vbYesNo, "Permit: " & pernum)
        If ui1 = vbNo Then Exit Sub
        FileToSearchFor = "Permit#" & pernum & ".pdf"
        RootFolder = "D:\WSOP 2020\Permits\"
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Debug.Print GetFiles(FSO, RootFolder, FileToSearchFor)

        'if a path is returned then open the pdf file
        'if not give an error message and carry on
    End If
End Sub

Can someone help me return the value, if any, found in the function back to a useable state after the function was called?

I'm struggling how to resume with the findings of the function.

 

[Ark68]

I think this is working ...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim RootFolder As String
    Dim FileToSearchFor As String
    Dim FSO As Object
    Dim test9 As String

    Cancel = True
    
    'select permit number to view permit
    If Not Intersect(Target, ws_master.Columns(3)) Is Nothing Then
        If Target.Value = "" Then Exit Sub
        pernum = Target.Value
        ui1 = MsgBox("Do you wish to view this permit?", vbYesNo, "Permit: " & pernum)
        If ui1 = vbNo Then Exit Sub
        FileToSearchFor = "Permit#" & pernum & ".pdf"
        RootFolder = "D:\WSOP 2020\Permits\"
        Set FSO = CreateObject("Scripting.FileSystemObject")
        'Debug.Print GetFiles(FSO, RootFolder, FileToSearchFor)
        test9 = GetFiles(FSO, RootFolder, FileToSearchFor)
        If test9 = "" Then
            MsgBox "No permit to view."
            Exit Sub
        End If
        MsgBox "Permit: " & pernum & Chr(13) & test9
    End If
End Sub