Excel VBAで「画像データ」と「保管場所」を一覧化する方法

商品データと保管場所の一覧を作成するために、簡易的なVBAスクリプトを作成しました。
このスクリプトは、「画像ファイルのパスをA列」に、".jpg" 拡張子を持つ「画像ファイルの名前をB列」に入力します。
すべてのフォルダーおよびサブフォルダーを検索してこの情報を収集するようになっています。
※約43万件のデータを約7分で完了できました。

fileName = Dir(folderPath & "*.jpg")
の「.jpg」の部分を変更すれば、別のファイルでもリスト化可能かと思います。

実行方法

• Excelの「F3」にフォルダーパスを入力してから

• 例　C:\Users\suzukimotors\Desktop\test

• VBAエディタを起動します（Alt + F11キー）。

• 「挿入」メニューから「モジュール」を選択して、新しいモジュールを作成します。

• 下記のコードをモジュールウィンドウに貼り付けます。

• マクロを実行します（Alt + F8キー、作成したマクロを選択して「実行」）。

Sub ListJPGFiles()
    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim folderPath As String
    folderPath = ws.Range("F3").Value

    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"

    ' 初期化
    Dim lastRow As Long
    lastRow = 2 ' B列の開始行

    ' ファイルを検索してリストに追加
    Call RecursiveSearch(folderPath, ws, lastRow)

    MsgBox "完了しました。", vbInformation
End Sub

Sub RecursiveSearch(ByVal folderPath As String, ws As Worksheet, ByRef lastRow As Long)
    Dim fileName As String
    Dim folder As Object, subFolder As Object
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' 現在のフォルダ内のjpgファイルを探す
    fileName = Dir(folderPath & "*.jpg")
    While fileName <> ""
        ws.Cells(lastRow, 1).Value = folderPath
        ws.Cells(lastRow, 2).Value = fileName
        lastRow = lastRow + 1
        fileName = Dir() ' 次のファイル
    Wend

    ' サブフォルダも検索
    Set folder = fso.GetFolder(folderPath)
    For Each subFolder In folder.SubFolders
        Call RecursiveSearch(subFolder.Path & "\", ws, lastRow)
    Next subFolder
End Sub