VBA Search for files with names containing string within folders and subfolders

问题

I am trying to write some code to search through a set of 600 folders (300 of which are empty) and all of their subfolders for filenames containing a string SearchTerm from a list of 6 such as "catchment table.xls", "catchment table.doc"

The names of any files found containing SearchTerm such as "Manchester Catchment Table 3.xlsx" Should be be input into list on sheet in a new workbook named after the Parent folder. So I end up with a workbook with 300 tabs each with a Parent folder title and a list of contained files containing the SearchTerm

Ideally I want to do this using FSO to compliment the current code which I got a lot of help with below that currently runs but does not produce enough tabs based on the parent folder names or list any of the files:

        Private x As String
Private y As String
Private z As String
Private Model As String
Private FileMatch As Object


'' current code to amend searches through all folders with names matching values in column a, checks if a folder exists with the same name, if the folder exists it then searches to find if there are any files/subfolders within it and the current folder size
Sub FolderSearcher_wildcard()
    Application.ScreenUpdating = False

    Dim sheet As Worksheet
    Set sheet = Workbooks("SubFolder Searcher_v2_list.xlsm").Sheets("Sheet1")
    Dim Rng As Range
    Set Rng = sheet.Range("A2:A527")
    Dim Pth As String
    Pth = sheet.Range("b2").Value

    For R = 2 To 527
        Model = sheet.Cells(R, 1).Text
        ModelPth = Pth & Model & "\" 'Pth already contains "\"

        CheckSubFolderContent ModelPth 'check to see if any of the sub folders within the folder contain files.
        sheet.Cells(R, 4).Value = x
        '''need to find a way of counting all files within the subfolders and summing this.

        CheckFolderContent ModelPth
        sheet.Cells(R, 5).Value = x
        sheet.Cells(R, 6).Value = y  'size of folder
        'sheet.Cells(r, 7).Value = z '''count of files within the folder
    Next R
End Sub

Sub CheckSubFolderContent(ModelPth)

    Dim SearchTerm As String 'wildcard term to search for
    Dim file As Variant
    Dim outputwb As Workbook
    Set outputwb = Workbooks("Folder_Searcher_Output.xlsx")

    SearchTerm = Range("b5").Value ''' will need to edit this to cycle through values in ("b5:b11")


    'Checks for content in subfolders in a folder specified by path
    x = "No Subfolders found"
    'Error handling for Model = ""
    If Right(ModelPth, 2) = "\\" Then
        x = "N/A"
        Exit Sub
    End If

    Dim FSO, Parent As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set Parent = FSO.GetFolder(ModelPth)
        If Err > 0 Then
            x = "Error! Parent folder does not exist."
            Exit Sub
        End If

            For Each SubFolder In Parent.SubFolders
                If SubFolder.Size = 0 Then
                x = "Folder has subfolders without content"
                z = 0

                    Else
                    x = "Folder has subfolders with content" ''' if this is true --- search all subfolders for files containing `SearchTerm`
                        With outputwb
                            .Sheets.Add.Name = Model ' if the folder has contents then a sheet is created to populate with file names
                        End With
                    R = 1
                    'create an entry on the Parent Folder sheet for every file matching the SearchTerm
                        For Each file In SubFolder.Files
                            If file.Name = SearchTerm Then
                                outputwb.Sheets(Model).Cells(R, 1).Value = file.Name
                                R = R + 1
                            End If
                        Next file

                End If
                Next


    'If Err > 0 Then x = "Error!"
    'On Error GoTo 0
End Sub
Sub CheckFolderContent(ModelPth)
    'Checks for content in a folder specified by path
    x = "No Subfolders found"
    If Right(ModelPth, 2) = "\\" Then
        x = "N/A"
        Exit Sub
    End If
        Dim FSO, Folder As Object
        Set FSO = CreateObject("Scripting.FileSystemObject")
        'On Error Resume Next
        Set Folder = FSO.GetFolder(ModelPth)
            If Err > 0 Then
                x = "Error! Parent folder does not exist."
                y = "n/a"
                z = "n/a"
                Exit Sub
            End If
                    If Folder.Size = 0 Then
                        x = "Folder is empty"
                        y = Folder.Size
                        z = 0
                    Else
                        x = "Folder has content"
                        y = Folder.Size
'                        With outputwb
'                            .Sheets.Add.Name = Model ' if the folder has contents then a sheet is created to populate with file names
'                        End With
                        'z = Folder.Files.Count
                    End If
                        'If Err > 0 Then x = "Error!"
                        'On Error GoTo 0
End Sub

来源：https://stackoverflow.com/questions/32272484/vba-search-for-files-with-names-containing-string-within-folders-and-subfolders