【ExcelVBA】フォルダの構成をシートに書き出すマクロ

フォルダの構成をシートに書き出すマクロを紹介します。

実行するとフォルダを選ぶダイアログが表示され、
選んだフォルダの構成を書き出した画像のシートを新規出力します。

フォルダ構成シート

B列のフォルダ名はセル内文字列のインデントを取って階層を表現しています。

実行型の便利マクロですので、
Excel起動時に裏で開かれる「個人用マクロブック」などに搭載して使ってください。

クイックアクセスツールバーやショートカットキーへの登録も便利です。

ソースコード

Option Explicit

Public FSO As New FileSystemObject

Sub フォルダの構成を新規シートに出力する()
    
    ' 対象フォルダをダイアログボックスで選択
    Dim Path対象フォルダ As String
    Path対象フォルダ = GetPathダイアログボックスでフォルダを選択する(ActiveWorkbook.Path)

    ' 新規シートを出力
    Dim ws出力シート As Worksheet
    Set ws出力シート = Workbooks.Add.Worksheets(1)

    ' 見出し・書式を設定
    ws出力シート.Range("A1") = "階層"
    ws出力シート.Range("B1") = "フォルダ名"
    ws出力シート.Range("C1") = "フォルダパス"
    ws出力シート.Rows(1).HorizontalAlignment = xlCenter
    ws出力シート.Columns(1).HorizontalAlignment = xlCenter
    ws出力シート.Rows(1).RowHeight = 27
    ws出力シート.Rows(1).VerticalAlignment = xlTop

    ' メインプロシージャ(再帰)
    Call フォルダ情報をシートに出力してサブフォルダに再帰する(Path対象フォルダ, ws出力シート, 1)
    
    ' 列幅を自動調整してからフィルターを設置
    ws出力シート.UsedRange.EntireColumn.AutoFit
    ws出力シート.Rows(1).AutoFilter

End Sub

' メインプロシージャ(再帰)
Private Sub フォルダ情報をシートに出力してサブフォルダに再帰する _
    (Path対象フォルダ As String, ws出力シート As Worksheet, 現階層 As Long)
    
    Dim 親フォルダ As Folder
    Set 親フォルダ = FSO.GetFolder(Path対象フォルダ)
    
    ' フォルダ情報の書き出し
    Dim R_出力 As Long: R_出力 = Get最終行(ws出力シート) + 1
    ws出力シート.Cells(R_出力, 1) = 現階層
    ws出力シート.Cells(R_出力, 2) = 親フォルダ.Name
    ws出力シート.Cells(R_出力, 2).IndentLevel = 現階層 - 1
    ws出力シート.Cells(R_出力, 3) = 親フォルダ.Path
    
    ' 下層フォルダに対して再帰呼出
    Dim 子フォルダ As Folder
    For Each 子フォルダ In 親フォルダ.SubFolders
        
        Call フォルダ情報をシートに出力してサブフォルダに再帰する(子フォルダ.Path, ws出力シート, 現階層 + 1)

    Next
    
End Sub

' 最終行の取得
Function Get最終行(シート As Worksheet) As Long
    Get最終行 = シート.UsedRange.Rows.Count + シート.UsedRange.Row - 1
End Function

' フォルダ選択ダイアログボックス
Function GetPathダイアログボックスでフォルダを選択する(Optional Path初期表示フォルダ As String = "") As String
    With Application.FileDialog(msoFileDialogFolderPicker)

        If Path初期表示フォルダ <> "" Then .InitialFileName = Path初期表示フォルダ

        If .Show Then GetPathダイアログボックスでフォルダを選択する = .SelectedItems(1)
    
    End With
End Function