Include SubFolders When Looking For The Existence of A File

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,860
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I'm using this code check to see if a particular file (a PDF file) exists within a folder.

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

Code:
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

Well-known Member
Joined
Mar 23, 2004
Messages
3,860
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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:

VBA Code:
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.
 

Some videos you may like

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

xenou

MrExcel MVP
Joined
Mar 2, 2007
Messages
16,825
Office Version
  1. 2019
Platform
  1. Windows
You may test this variation (I believe it amounts to a depth first search...)...

VBA Code:
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
 
Solution

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
3,860
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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 ...

VBA Code:
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

Well-known Member
Joined
Mar 23, 2004
Messages
3,860
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I think this is working ...
VBA Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,698
Messages
5,626,375
Members
416,176
Latest member
Dyl

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top