【Excel VBA】指定したフォルダ内の全てのサブフォルダ名を取得する

指定したフォルダ内のサブフォルダ及びそのサブフォルダ以下の下層にある全てのフォルダ名をリスト化するマクロを紹介します。

マクロ実行対象が一つのフォルダ内で完結していない場合（日付別でのフォルダ管理をしている、等）に応用できます。

＜マクロ実行結果のイメージ＞
下図のようなフォルダ構成に対して「test_folder」以下のフォルダ名のリストを作成します

↓マクロ実行結果（フォルダダイアログで”test_folder”フォルダを指定した場合）

実行したコードは以下の通りです。

Dim FSO As Object
Dim Folder As Object
Dim SUB_Folder As Object
Dim Folder_Path As String
Dim LastRow As Long

Sub フォルダ内の全てのサブフォルダ名のリスト化()

 'フォルダダイアログでフォルダを選択する
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Title = "フォルダを選択してください"
    .Show
    If .SelectedItems.Count = 0 Then Exit Sub
        Folder_Path = .SelectedItems(1)
End With

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(Folder_Path)

LastRow = Range("A1048576").End(xlUp).Row + 1
    If LastRow = 2 Then
        Cells(1, 1).Value = Folder.Name
    Else
        Cells(LastRow, 1).Value = Folder.Name
    End If
    
Call 関数(Folder_Path)
       
End Sub
    

Sub 関数(Folder_Path)

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder(Folder_Path)

    For Each SUB_Folder In Folder.subfolders  'フォルダ内のサブフォルダ全てに処理を実行
        LastRow = Range("A1048576").End(xlUp).Row + 1
        Cells(LastRow, 1).Value = SUB_Folder.Name ' フォルダ名をセルに記入する
        
        Call 関数(SUB_Folder) 'サブフォルダ内のサブフォルダに処理を実行する
        
    Next SUB_Folder

    
End Sub

上記コードについて、まずはリスト化したいフォルダをフォルダダイアログで選択し、
「FileSystemObject」を使用してフォルダ名を取得します。

選択したフォルダ内のサブフォルダ名を取得するために”関数（引数=フォルダパス）”を呼び出して、サブフォルダ名を取得していきます。

ただし、サブフォルダ内にもサブフォルダが存在している可能性があるため、サブフォルダのパスに対して関数を処理している中で更に”関数（引数=サブフォルダパス）”を呼び出し、再起関数による再起処理を実行することで、サブフォルダ内のサブフォルダ名の取得も行っていきます。

このマクロではフォルダ名を1個ずつ取得していく処理になっているため、フォルダ内のファイルへの処理追加は上記コードの中に処理を挿入していくことで実装が可能になります。