excel - VBA macro that search for file in multiple subfolders

Question

I have macro, if I put in cell E1 name of the file, macro search trough C:UsersMarekDesktopMakro directory, find it and put the needed values in specific cells of my original file with macro.

Is it possible to make this work without specific folder location? I need something that can search trough C:UsersMarekDesktopMakro with many subfolders in it.

My code:

Sub Zila1()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant
Dim YrMth As String

SaveDriveDir = CurDir
MyPath = Application.DefaultFilePath    'or use "C:Data"
ChDrive MyPath
ChDir MyPath
FName = Sheets("Sheet1").Range("E1").Text

If FName = False Then
    'do nothing
Else
    GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
        "A16:A17", Sheets("Sheet1").Range("B2:B3"), True, False

        GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
        "AE23:AE24", Sheets("Sheet1").Range("B3:B4"), True, False

        GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
        "AE26:AE27", Sheets("Sheet1").Range("B4:B5"), True, False

        GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
        "AQ59:AQ60", Sheets("Sheet1").Range("B5:B6"), True, False

        GetData "C:UsersMarekDesktopMakro" & FName & ".xls", "Vystupna_kontrola", _
        "AR65:AR66", Sheets("Sheet1").Range("B6:B7"), True, False

        End If

  ChDrive SaveDriveDir
  ChDir SaveDriveDir
End Sub

Answer 1

Just for fun, here's a sample with a recursive function which (I hope) should be a bit simpler to understand and to use with your code:

Function Recurse(sPath As String) As String

    Dim FSO As New FileSystemObject
    Dim myFolder As Folder
    Dim mySubFolder As Folder

    Set myFolder = FSO.GetFolder(sPath)
    For Each mySubFolder In myFolder.SubFolders
        Call TestSub(mySubFolder.Path)
        Recurse = Recurse(mySubFolder.Path)
    Next

End Function

Sub TestR()

    Call Recurse("D:Projets")

End Sub

Sub TestSub(ByVal s As String)

    Debug.Print s

End Sub

Edit: Here's how you can implement this code in your workbook to achieve your objective.

Sub TestSub(ByVal s As String)

    Dim FSO As New FileSystemObject
    Dim myFolder As Folder
    Dim myFile As File

    Set myFolder = FSO.GetFolder(s)
    For Each myFile In myFolder.Files
        If myFile.Name = Range("E1").Value Then
            Debug.Print myFile.Name 'Or do whatever you want with the file
        End If
    Next

End Sub

Here, I just debug the name of the found file, the rest is up to you. ;)

Of course, some would say it's a bit clumsy to call twice the FileSystemObject so you could simply write your code like this (depends on wether you want to compartmentalize or not):

Function Recurse(sPath As String) As String

    Dim FSO As New FileSystemObject
    Dim myFolder As Folder
    Dim mySubFolder As Folder
    Dim myFile As File

    Set myFolder = FSO.GetFolder(sPath)

    For Each mySubFolder In myFolder.SubFolders
        For Each myFile In mySubFolder.Files
            If myFile.Name = Range("E1").Value Then
                Debug.Print myFile.Name & " in " & myFile.Path 'Or do whatever you want with the file
                Exit For
            End If
        Next
        Recurse = Recurse(mySubFolder.Path)
    Next

End Function

Sub TestR()

    Call Recurse("D:Projets")

End Sub