VBAでサブフォルダにあるファイルも含めてファイル名の一覧を取得する

Option Explicit

Sub Sample()
    Const SEARCH_DIR As String = "C:\Users\xxx"  'フォルダ名の末尾の"\"は不要
    Const SEARCH_FILE As String = "*.png" 'constで定数を宣言
    Dim tmpFile As String
    Dim strCmd As String
    Dim buf() As Byte
    Dim FileList() As String
    Dim myArray() As String
    Dim cnt As Long, pt As Long, i As Long

    '変数tmpFileにDirコマンドの結果を出力する一時ファイルのプルパスを格納
    'Dirコマンド:フォルダ内にあるファイル名を一覧取得するコマンド
    'EnvironはWindowsのtempディレクトリの環境変数を取得する関数
    tmpFile = Environ("TEMP") & "\Dir.tmp"


    'Dirコマンド用の文字列を編集
    'Dir C:\Users\*.png /b/s/a:-d > \Dir.tmp
    '/b ファイル名のみ表示。見出しや要約が付きません
    '/s 指定されたディレクトリおよびそのサブディレクトリのすべてのファイルを表示
    '/a 属性。"-"で指定した属性を除く。"-d"でディレクトリ（フォルダ）を除くという意味
    strCmd = "Dir """ & SEARCH_DIR & "\" & SEARCH_FILE & """ /b/s/a:-d > """ & tmpFile & """"

    'WSHでDirコマンドを実行
    'VBAで他のアプリケーションを利用するためにShell関数を使用
    'Wscript(Windows Script Host)のWshShellクラスを利用
    '.Run(起動するコマンド、[ウィンドウのスタイル], [起動したコマンドの終了待ちをするかしないか])
    'Runコマンドで実行。cmd /cでcディレクトリに移動し、stcCmdに格納されているコマンドを実行
    '7はウィンドウを最小化ウィンドウとして表示するという意味
    'Trueはコマンドの終了を待ってからスクリプトを実行するという意味
    With CreateObject("Wscript.Shell")
         .Run "cmd /c" & strCmd, 7, True
    End With

    '該当ファイルの存在チェック
    If FileLen(tmpFile) < 1 Then
        MsgBox "該当するファイルがありません"
        Exit Sub
    End If

    'Dirコマンドの結果を出力した一時ファイルを読み込み
    'FileSystemObjectクラスではバイナリファイルを開けないため、Openステートメントを使ってバイナリファイルを読み込み
    'ReDimでbufを再定義
    Open tmpFile For Binary As #1
        ReDim buf(1 To LOF(1))
        Get #1, , buf
    Close #1
    Kill tmpFile

    'vbCrLfは改行コード
    'StrConv関数でバイナリ形式から、vbUnicode形式に変更
    'Split関数でテキストを改行ごとに分割
    FileList() = Split(StrConv(buf, vbUnicode), vbCrLf)

    'Dirコマンドの出力件数
    cnt = UBound(FileList)

    'ワークシート書き出し用の配列 ---------(2)
    ReDim myArray(1 To cnt, 1 To 2)
    For i = 1 To cnt
        pt = InStrRev(FileList(i - 1), "\")
        myArray(i, 1) = Left(FileList(i - 1), pt)    'パス
        myArray(i, 2) = Mid(FileList(i - 1), pt + 1) 'ファイル名
    Next i

   '配列の値をワークシートに出力
    ActiveSheet.UsedRange.ClearContents
    Range("A1").Value = "パス"
    Range("B1").Value = "ファイル名"
    Range("A2").Resize(cnt, 2).Value = myArray
End Sub