VBA在文件夹和子文件夹中搜索名称包含字符串的文件

Question

我正在尝试编写一些代码来搜索一组600个文件夹（其中300个为空）以及所有文件名的子文件夹，其中包含来自6个列表中的字符串SearchTerm，例如＆＃34 ; 集水表 .xls＆＃34;，＆＃34; 集水表 .doc＆＃34;

包含SearchTerm的所有文件的名称，例如＆＃34;曼彻斯特Catchment表3.xlsx＆＃34;应该在以Parent文件夹命名的新工作簿中输入到工作表中的列表。所以我最终得到一个包含300个标签的工作簿，每个标签包含Parent文件夹标题和包含SearchTerm

的包含文件的列表

理想情况下，我希望使用FSO来补充当前运行但我没有根据父文件夹名称生成足够的选项卡或列出任何文件的当前代码，我得到了很多帮助：

        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