给定路径，转到子文件夹并列出所有 Excel 文件

Question

给定文件路径。我试图导入该文件夹中所有以 '001-'100 开头的 (xlsx) 文件（到目前为止，我能够使用以下宏导入它们）

Sub Select_Folder()
    'returns a list of files located in the indicated folder

    Dim directory As String
    Dim firstFile As String
    Dim dataFile As String
    ''Dim bottom As String
    Dim IB As String
    Dim diaFolder As FileDialog

    'checks to see if Filter Mode is on.
    'Prompts the user to turn off filter mode
    'and aborts the function

    If Sheets("Master").FilterMode = True Then
        MsgBox "The Macro was aborted for the following reason:" & vbNewLine & _
        "The Filter on this sheet is still active." & vbNewLine & _
        "Please turn off FilterMode off to continue. (Error: 002)", vbCritical + vbApplicationModal, "Microsoft Excel"
        End
    End If

    'Turn Off Screen Updating and
    'Event Handiling
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With



    Sheets("Master").Range("C4", Range("C4").End(xlDown)).EntireRow.Delete

    'the directory is taken from the inputs on the spreadsheet 

    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    With diaFolder
        .AllowMultiSelect = False
        .InitialFileName = "C:\Users\"
        On Error GoTo Err2:
        .Show
        directory = .SelectedItems(1) & "\"
    End With
    Set diaFolder = Nothing

    If Len(Dir(directory, vbDirectory)) = 0 Then
        MsgBox "The Macro was aborted for the following reason:" & vbNewLine & _
        "The directory " & directory & " Does not exist." & vbNewLine & _
        "Please check to make sure that this directory exists. (Error: 005)", vbCritical + vbApplicationModal, "No Directory Exists"
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        End
    End If

    'sets the first file in the folder
    'if no first file exists, the program ends

    firstFile = Dir(directory)

    If firstFile = "" Then
        MsgBox "The Macro was aborted for the following reason:" & vbNewLine & _
        "There are no files in the directory: " & directory & vbNewLine & _
        "Please check to make sure that there are files in this Directory. (Error: 006)", vbCritical + vbApplicationModal, "No Files Exist"
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        End
    End If

    'places the first file in the first row

    Range("B4") = -1
    Range("D4") = firstFile
    Range("C4") = Left(firstFile, Application.WorksheetFunction.Search(" ", firstFile) - 1)
    Range("D2") = directory

    'finds the next files in the folder
    'Looks at the first four characters in the file name
    'if the first four characters returned.

    Do
        dataFile = Dir()
        If dataFile = "" Then
            Exit Do
        ElseIf Left(dataFile, 4) <> "Term" And Left(dataFile, 4) <> "Inac" Then
            Range("D4").Select
            'finds the next blank cell in range "D5"
'            Do Until ActiveCell.Value = ""
            Do Until ActiveCell.Text = ""
                ActiveCell.Offset(1, 0).Activate
            Loop

            ActiveCell.Value = dataFile
            IB = Left(dataFile, Application.WorksheetFunction.Search(" ", dataFile) - 1)
            ActiveCell.Offset(0, -1).Value = IB
            ActiveCell.Offset(0, -2).Value = -1
        End If
    Loop

    'finds the lowest cell in the range to set as the base
    'fills two formulas to find the Name and Type of Report starting at E4 and F4
    'Autofits Columns E and F
Err2:
    Exit Sub
End Sub

现在我不仅希望能够对该文件夹执行此操作，还希望能够对其中的文件夹（子文件夹）执行此操作。

我尝试实现

Sub DoFolderFolder_backup()
    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next
    Dim File
    For Each File In Folder.Files
        ' Operate on each file
    Call Select_Folder
    Next

请帮我。

“主表”的格式如下