nono’s blog

山歩き、仕事の事、中国の事

【Excel VBA】選択したフォルダとそのサブフォルダ内の全てのファイルをExcelファイルに書き出すマクロ

Excelで選択したフォルダと、そのサブフォルダ内の全てのファイルについて、
ファイル名と格納フォルダパスをExcelファイルに書き出すマクロです。

<使い方>
ExcelVBAに下記のソースコードを貼り付ける
Excelで空白シートを選択する
Excelで当マクロ(GetFileList_ALLSub)を実行する
・ダイヤログボックスが表示されるので、処理したいフォルダを選択してOKを押す

ソースコード

Dim cnt As Long
Dim Path As String

Sub GetFileList_ALLSub()
'ダイヤログボックスを表示
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = True Then
        Path = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With

cnt = 0
ActiveSheet.Cells.Clear
Call ReCall_GFolder(Path)
Application.StatusBar = False
MsgBox "完了"
End Sub

Sub ReCall_GFolder(Path) 'Recursive Call GetFolder
Dim buf As String, f As Object

'フォルダ内のファイル取得処理
On Error Resume Next
buf = Dir(Path & "\*.*")
Do While buf <> ""
    cnt = cnt + 1
    Application.StatusBar = "実行中... ( " & cnt & "件目 )"
    Cells(cnt, 1) = buf
    Cells(cnt, 2) = Path
    buf = Dir()
Loop

'配下フォルダのPathを指定して再帰処理
With CreateObject("Scripting.FileSystemObject")
    For Each f In .GetFolder(Path).SubFolders
        Call ReCall_GFolder(f.Path)
    Next f
End With
End Sub

<細かい仕様>
・1列目にファイル名、2列目にファイルパスを出力する
・処理前に選択されているシートをクリアする
・左下のステータスバーに処理件数を表示する
・処理が完了したらメッセージBOXで””完了”を表示する

<今後の改善案メモ>
・配列処理にして処理速度アップ
・件数が多くても固まらないようにする
・1行目に項目名を出力する