選択したディレクトリの配下にあるディレクトリのExcelファイルパスを全て取得

Sub GetAllExcelFiles()
    Dim folderPath As String
    Dim filePaths As Collection
    Set filePaths = New Collection

    ' フォルダダイアログを表示してフォルダを選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダを選択してください"
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    ' 指定したフォルダ以下のすべてのExcelファイルを取得
    GetExcelFilesInDirectory folderPath, filePaths

    ' 取得したファイルパスを出力
    Dim filePath As Variant
    For Each filePath In filePaths
        Debug.Print filePath
    Next filePath
End Sub

Sub GetExcelFilesInDirectory(ByVal folderPath As String, ByRef filePaths As Collection)
    Dim fso As Object
    Dim folder As Object
    Dim subFolder As Object
    Dim file As Object

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)

    ' 現在のフォルダ内のファイルを処理
    For Each file In folder.Files
        If InStr(1, file.Name, ".xls", vbTextCompare) > 0 Then
            filePaths.Add file.Path
        End If
    Next file

    ' サブフォルダ内のファイルを再帰的に処理
    For Each subFolder In folder.SubFolders
        GetExcelFilesInDirectory subFolder.Path, filePaths
    Next subFolder
End Sub