'ファイルタイム
Private Type FILETIME
     dwLowDateTime As Long
     dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
     dwFileAttributes As Long       'ファイル属性
     ftCreationTime As FILETIME     '作成日
     ftLastAccessTime As FILETIME   'アクセス日
     ftLastWriteTime As FILETIME    '更新日
     nFileSizeHigh As Long          'ファイルサイズ(Byte)
     nFileSizeLow As Long           'ファイルサイズ(Byte)
     dwReserved0 As Long            '未使用
     dwReserved1 As Long            '未使用
     cFileName As String * 260      'ファイル名
     cAlternate As String * 14      'ファイル名フォーマット名
End Type

'ファイルの検索を開始する
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

'ファイルの検索を続行する
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

'検索ハンドルを閉じる
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Const INVALID_HANDLE_VALUE = -1

'-----------------------------------------------------------------------
' 関数名 ： FindExecute
' 機能   ： 検索を開始する
' 引数   ： (in/out) Files … ファイル配列
'           (in)DirName … 検索元ディレクトリ
'           (in)Extension … 拡張子
' 返り値 ： True：正常終了る  False：異常終了
'-----------------------------------------------------------------------
Public Function FindExecute(ByRef Files() As String, ByVal DirName As String, ByVal Extension As String)

    Dim Dirs() As String
    Dim FuncRet As Boolean
    Dim i As Long

    Dim OneChar As String
    OneChar = Right$(DirName, 1)
    If OneChar = "\" Then
        DirName = DirName & "*"
    Else
        DirName = DirName & "\*"
    End If

    'ディレクトリ取得
    FuncRet = EnumDirectory(Dirs, DirName)
    If FuncRet = False Then Exit Function

    'ファイル取得
    For i = 0 To UBound(Dirs)
        Call EnumFile(Files, Dirs(i), Extension)
    Next i

    FindExecute = True

End Function


'-----------------------------------------------------------------------
' 関数名 ： EnumDirectory
' 機能   ： ディレクトリを列挙する
' 引数   ： (in/out) Dirs … ディレクトリ名配列
'           (in)DirNameWithAst … 検索元ディレクトリ(アスタリスク付き)
' 返り値 ： True：ディレクトリは存在する  False：存在しない
'-----------------------------------------------------------------------
Public Function EnumDirectory(ByRef Dirs() As String, _
                              ByVal DirNameWithAst As String) As Boolean

    Dim udtWin32 As WIN32_FIND_DATA
    Dim hFile As Long                'ファイルハンドル
    Dim ArrayIndex As Long
    Dim DirName As String
    Dim Win32FileName As String

    '検索開始
    hFile = FindFirstFile(DirNameWithAst, udtWin32)
    'ファイル・ディレクトリが存在しない場合は終了
    If hFile = INVALID_HANDLE_VALUE Then Exit Function

    'DirNameWithAst にはアスタリスクが付いているので削除しておく
    DirName = Left$(DirNameWithAst, Len(DirNameWithAst) - 1)

    '初回実行時 Files は配列無しなのでUBound()でエラーとなる
    'それを回避するための強制エラー無視ロジック
    On Error Resume Next
    ArrayIndex = UBound(Dirs)
    On Error GoTo 0
    '初回のみインデックス0番目に渡された引数を設定する
    If ArrayIndex = 0 Then
        ReDim Dirs(ArrayIndex) As String
        'C:等のドライブ指定ではない場合
        If Len(DirName) > 3 Then
            Dirs(ArrayIndex) = Left$(DirName, Len(DirName) - 1)
        'C:等のドライブ指定である場合
        Else
            Dirs(ArrayIndex) = DirName
        End If
    End If

    Do
        'ディレクトリである
        If (udtWin32.dwFileAttributes And vbDirectory) = vbDirectory Then
            '再描画してあげましょう
            DoEvents

            'ディレクトリ名を取得
            Win32FileName = Left$(udtWin32.cFileName, _
                     InStr(udtWin32.cFileName, Chr$(0)) - 1)
            '親ディレクトリ、カレントディレクトリは無視
            If Left$(Win32FileName, 1) <> "." Then
                '配列インデックス確保
                ArrayIndex = UBound(Dirs) + 1

                'メモリー確保
                ReDim Preserve Dirs(ArrayIndex) As String

                'フルパスでディレクトリを設定
                Dirs(ArrayIndex) = DirName & Win32FileName

                'さあここで再帰だ!! 返り値を見る必要はないでしょう
                Call EnumDirectory(Dirs, Dirs(ArrayIndex) & "\*")
            End If
        End If
    Loop While FindNextFile(hFile, udtWin32) <> 0

    Call FindClose(hFile)

    EnumDirectory = True

End Function


'-----------------------------------------------------------------------
' 関数名 ： EnumFile
' 機能   ： ディレクトリ以下のファイルを列挙する
' 引数   ： (in/out) Files … ファイル配列
'           (in)Directory … ディレクトリ
'           (in)Extension … 拡張子
' 返り値 ：なし
'-----------------------------------------------------------------------
Public Sub EnumFile(ByRef Files() As String, ByVal Directory As String, _
                    ByVal Extension As String)

    Dim udtWin32 As WIN32_FIND_DATA
    Dim hFile As Long                'ファイルハンドル
    Dim ArrayIndex As Long

    '検索開始
    hFile = FindFirstFile(Directory & "\*." & Extension, udtWin32)
    'ファイルが存在しない場合は終了
    If hFile = INVALID_HANDLE_VALUE Then Exit Sub

    Do
        '時々、再描画してあげましょう
        If ArrayIndex Mod 30 = 0 Then DoEvents

        '初回実行時 Files は配列無しなのでUBound()でエラーとなる
        'それを回避するための強制エラー無視ロジック
        On Error Resume Next
        ArrayIndex = UBound(Files) + 1
        On Error GoTo 0

        'メモリー確保
        ReDim Preserve Files(ArrayIndex) As String

        'ファイル名取得
        Files(ArrayIndex) = Directory & "\" & Left$(udtWin32.cFileName, _
                     InStr(udtWin32.cFileName, Chr$(0)) - 1)

    Loop While FindNextFile(hFile, udtWin32) <> 0

    Call FindClose(hFile)

End Sub

以下は実行ロジック

Private Sub Command1_Click()

    Dim Files() As String
    Dim i As Long

    If FindExecute(Files, "C:\Program Files\", "txt") Then
        For i = 0 To UBound(Files)
            Debug.Print Files(i)
        Next i
    End If
    Debug.Print CStr(i) & "個のファイルが見つかりました"

End Sub