【VBA】フォルダ内のファイル一覧を再帰的に取得してExcelに作成する。

#VBAでフォルダ内のファイルリストを作成する。（サブフォルダを含めて再帰的に）

D:\Hoge\hogeフォルダ内をサブフォルダを含めてすべてのファイルを取得し、
マクロブック内の結果シートにファイルリストを作りたい、と思ったことがありました。その時のメモです。

はじめに。下記を参考にしました。

再帰処理に関しては下記を見た方がいいです。

• moug

https://www.moug.net/tech/exvba/0060088.html

• Office TANAKA

http://officetanaka.net/excel/vba/tips/tips95.htm

やることは以下の2つです。

• Dir関数でフォルダ内の全部ファイルを取得する。
• FileSystemObjectでサブフォルダをすべて取得する。

Dim cnt As Long

'Main procedure
Sub Create_BookList_From_Folder()
    Dim MyPath As String
    Dim stKekka As Worksheet
    Set stKekka = ThisWorkbook.Worksheets("結果")
    MyPath = "D:\Hoge\hoge"
    cnt = 1
	with stKekka
		.Cells.ClearContents
		.Cells(1, 1).Value = "FullName"
		.Cells(1, 2).Value = "FolderName"
		.Cells(1, 3).Value = "FileName"    
	End With
	Call Create_BookList_From_Folder2(MyPath)
End Sub

上記から呼ばれるprocedure

Sub Create_BookList_From_Folder2(MyPath As String)
    Dim buf As String
    Dim stKekka As Worksheet
    Set stKekka = ThisWorkbook.Worksheets("結果")

    'ファイルの処理
    buf = Dir(MyPath & "\" & "*.*")
    Do While buf <> ""
        If Not (MyPath & "\" & buf) Like "*.pdf" Then
            cnt = cnt + 1
            with stKekka
                .Cells(cnt, 1).Value = MyPath & "\" & buf
                .Cells(cnt, 2).Value = MyPath
                .Cells(cnt, 3).Value = buf
            End With
        End If
        buf = Dir()
    Loop

    'サブフォルダの数だけ自分自身を呼び出す。
    With CreateObject("Scripting.FileSystemObject")
        For Each f In .GetFolder(MyPath).SubFolders
            Call Create_BookList_From_Folder2(f.Path)
        Next f
    End With
End Sub

#Dir関数だけでやる場合

Dir関数でも第2引数にVbdirectory定数を渡せば、サブフォルダを含めて取得することができるらしい。その場合、Getattr関数でディレクトリかどうかを判定する。

Dir

Sub Dirでサブフォルダ再帰的処理()
    Dim buf As String
    buf = Dir("*.*", vbDirectory)
    Do While buf <> ""
        If GetAttr(buf) = vbDirectory Then
              'フォルダだったらここにサブフォルダを処理する関数を作って呼び出す。

        ElseIf GetAttr(buf) = vbNormal Then
              '通常ファイルに対する処理
        End If
        buf = Dir()
    Loop
End Sub