指定フォルダ以下を検索して、ファイルをリストアップ

標準モジュールに以下の記述を行います。

Public GetFileList() As String
Public GetFileListCount As Integer

Public Sub GetFList( _
ByVal Path As String _
, ByVal MySort1 As String _
, ByVal MySort2 As String _
, ByVal MySort3 As String)

'戻り値	無し
'Path = 		ファイルの検索を開始するフォルダを指定します
'MySort1 MySort2 MySort3 =		リストアップする拡張子を指定します
'
Dim MyPath As String
Dim MyName As String
Dim PathList() As String
Dim PathCount As Integer
Dim tmpStr As String
Dim I As Integer 'カウンター用
Dim FileSort as string
Dim Check1 as Boolean

    'パスの右端に￥が有るかチェック
    If Right$(Path, 1) = "\" Then
        MyPath = Path  ' パスを設定します。
    Else
        MyPath = Path & "\"  ' パスを設定します。
    End If

    
    MyName = Dir(MyPath, vbDirectory)   ' 最初のフォルダ名を返します。
    Do While MyName <> ""   ' ループを開始します。
        ' 現在のフォルダと親フォルダは無視します。
    
        If MyName <> "." And MyName <> ".." Then
            
            tmpStr = MyPath & MyName

            ' ビット単位の比較を行い、MyName がフォルダかどうかを調べます。
            If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
                'フォルダの時の処理
                '検索されたパスをリストに追加する処理
                PathCount = PathCount + 1
                ReDim Preserve PathList(1 To PathCount)
                PathList(PathCount) = tmpStr
            Else
                '拡張子の取得処理
                I = 0
                Check1 = True
                Do While Check1
                    I = I + 1
                    FileSort = Rigth$(tmpStr,I)
                    If Left$(FileSort,1) = "." Then
                        FileSort = Rigth$(FileSort,I - 1)
                        Check1 = False
                    End If
                Loop

                '拡張子によるファイルの選別
                '必要に応じて、対象拡張子を増やして下さい。
                Select Case UCase(FileSort)
                    Case MySort1 , MySort2 , MySort3
                        GetFileListCount = GetFileListCount + 1
                        ReDim Preserve GetFileList(1 To GetFileListCount)
                        GetFileList(GetFileListCount) = tmpStr
                End Select
            End If
        End If
        MyName = Dir                    ' 次のフォルダ名を返します。
    Loop
    
    '検出された別フォルダを調べに行きます。
    For I = 1 To PathCount
        GetFList PathList(I) , MySort1 , MySort2 , MySort3
    Next I
    
End Sub

For I = 1 To GetFileListCount
    Debug.Print GetFileList(I) & vbcrlf
Next I