指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得（Excel VBA）

【本日のミッション】

Excel VBAにて指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得し、一覧表を作成せよ。

以前お話ししました

指定したフォルダ内のサブフォルダのフォルダ名を全部取得（Excel VBA）
指定したフォルダ内とサブフォルダ内全てのファイル名を取得（Excel VBA）

から更に進歩です！！

1 ミッションの概要
2 ファイルの準備とプロシージャ
3 フォルダとファイルの処理の順番
4 FileSystemObjectとは
5 再帰処理とは
6 Callステートメントとは
7 【参考】

ミッションの概要

セルB3に、フォルダ・サブフォルダ・ファイル名を取得したいフォルダのパスを入力
セルB6に、一覧表を作りたいセル範囲の左上のセルアドレスを入力
<フォルダ・ファイル名一覧作成>ボタンをポチっと

すると、セルB6に入力したアドレスに、ファイル・フォルダ一覧表が完成です。

対象フォルダパス「C:\VBA」の中には下記フォルダ・ファイルが入っています。

完成した表は下記の通りになります。

今回の作表はこちらのサイト様を参考に作らせていただきました。

エクセルの神髄

■■■スポンサーリンク■■■

ファイルの準備とプロシージャ

Excelマクロ有効ブック（.xlsm）のファイルを新規作成します。

そのファイルのシートに下記の通り、フォルダのパスを入力するセル（B3）、取得したファイル名を書き出すセル（B6）、VBAを登録するボタンを準備します。

フォルダパス（B3)には、取得したいフォルダ・ファイルが入っているフォルダのフルパスを入力します。

Alt＋F11でVsual Basic Editerを起動します。

［挿入］－［標準モジュール］で新規モジュールを作成し、下記の通りコードを記入します。

'【変数】
Dim s_row As Long '開始行
Dim s_col As Long '開始列
Dim e_col As Long '終了列

Sub 指定したフォルダ内の全階層のフォルダ名とファイル名で一覧作成()
    '【変数】
    'ファイル・シート関連関連
    Dim FSO As Object   'FileSystemObject
    Dim pt As String    '対象フォルダパス
    '行列関連
    Dim t_row As Long   '対象行
    Dim t_col As Long   '対象列

    Application.ScreenUpdating = False '画面表示の停止

    '■変数セット
    s_row = Range(Range("B6")).Row    '開始行
    s_col = Range(Range("B6")).Column '開始行
    t_row = s_row + 1                 '対象行
    t_col = s_col                     '対象列
    e_col = t_col                     '最終列

    '■FileSystemObjectのインスタンス化
    Set FSO = CreateObject("Scripting.FileSystemObject")

    '■対象フォルダパス（最後に「\」が無ければ「\」を付ける）
    If Right(pt, 1) = "\" Then
        pt = Range("B3")
    Else
        pt = Range("B3") & "\"
    End If

    '■対象フォルダの有無の確認
    If Not FSO.FolderExists(pt) Then
        MsgBox ("ご指定のフォルダは存在しません。")
        Exit Sub
    End If

    '■前回データのクリア
    Rows(s_row & ":" & Cells.Rows.Count).Clear

    '■再帰処理開始
    Call フォルダファイル名取得(FSO, pt, t_row, t_col)

    '■列幅の調整
    Range(Columns(t_col), Columns(Columns.Count)).ColumnWidth = 3
    Range(Columns(e_col), Columns(e_col + 2)).EntireColumn.AutoFit

    '■サイズ、更新日時の罫線設定
    Range(Cells(s_row, e_col + 1), Cells(t_row - 1, e_col + 1)).BorderAround Weight:=xlHairline, LineStyle:=xlContinuous
    Range(Cells(s_row, t_col), Cells(t_row - 1, e_col + 2)).BorderAround LineStyle:=xlContinuous

    '■見出し設定
    Cells(s_row, s_col) = "フォルダ・ファイル名"
    Cells(s_row, e_col + 1) = "サイズ"
    Cells(s_row, e_col + 2) = "更新日時"
    Range(Cells(s_row, e_col + 1), Cells(s_row, e_col + 2)).HorizontalAlignment = xlCenter

    Application.Goto reference:=Range("A1"), scroll:=True
    Range(Range("B3"), Range("XFD2")).ClearFormats

    '■オブジェクトの解放
    Set FSO = Nothing

    Application.ScreenUpdating = False '画面表示の再開

End Sub

Sub フォルダファイル名取得(FSO As Object, pt As String, t_row As Long, t_col As Long)

    '【変数】
    Dim s_fd As Object 'サブフォルダ
    Dim fl As Object 'ファイル
    Dim strSplit() As String

    '■最終列が増えた場合、サイズ列の前に1列追加
    If t_col > e_col Then
        Columns(t_col).Insert Shift:=xlToRight
        e_col = t_col
    End If

    '■サブフォルダの取得
    For Each s_fd In FSO.GetFolder(pt).SubFolders '変数s_fdに対象フォルダ内のサブフォルダを順に取得

        '□サブフォルダ名転記
        Cells(t_row, t_col) = s_fd.Name

        '□サブフォルダにハイパーリンクを設定
        ActiveSheet.Hyperlinks.Add _
            Anchor:=Cells(t_row, t_col), _
            Address:=s_fd.Path, _
            TextToDisplay:=s_fd.Name

        '□サブフォルダ名罫線設定
        Call 罫線(t_row, t_col)

        t_row = t_row + 1

        '□再帰処理
        Call フォルダファイル名取得(FSO, s_fd.Path, t_row, t_col + 1)
    Next s_fd

    '■ファイル名の取得
    For Each fl In FSO.GetFolder(pt).Files

        '□ファイル名転記
        Cells(t_row, t_col) = fl.Name

        '■Excel・csvファイルはハイパーリンク設定
        strSplit = Split(fl.Path, ".")

        If UBound(strSplit) > 0 Then
            Select Case LCase(strSplit(UBound(strSplit)))
                Case "xls", "xlsx", "xlsm", "csv"
                    ActiveSheet.Hyperlinks.Add _
                        Anchor:=Cells(t_row, t_col), _
                        Address:=fl.Path, _
                        TextToDisplay:=fl.Name
            End Select
        End If

        '□ファイルサイズ・更新日時転記
        Cells(t_row, e_col + 1) = WorksheetFunction.RoundUp(fl.Size / 1024, 0)
        Cells(t_row, e_col + 1).NumberFormatLocal = "#,##0 ""KB"""
        Cells(t_row, e_col + 2) = fl.DateLastModified
        Cells(t_row, e_col + 2).NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"

        '■ファイル名罫線
        Call 罫線(t_row, t_col)

        t_row = t_row + 1
    Next fl

    '■オブジェクトの解放
    Set s_fd = Nothing
    Set fl = Nothing

End Sub

Sub 罫線(t_row As Long, t_col As Long)

    '■左の罫線
    If t_col > s_col Then
        With Range(Cells(t_row, s_col), Cells(t_row, t_col - 1))
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlInsideVertical).LineStyle = xlContinuous
        End With
    End If

    '■上の罫線
    With Range(Cells(t_row, t_col), Cells(t_row, e_col + 2))
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
    End With

End Sub

元のExcelの画面に戻り、ボタン用に作ったオブジェクトを選択し、右クリックー［マクロの登録］を選択します。

マクロの登録画面にて、マクロの保存先ー［作業中のブック］にして「指定したフォルダ内の全階層のフォルダ名とファイル名で一覧作成」を選択し、<OK>をクリックします。

マクロを登録したボタンをクリックしてください。

いかがですか？一覧表は作成できましたか？

フォルダとファイルの処理の順番

今回の例では、フォルダとファイルの処理の順番は、下図の通りになります。
第1階層のファイルの処理が一番最後になるなんて意外ですよね。

FileSystemObjectとは

FileSystemObjectにつきましては、下記ページをご参照ください。

FileSystemObjectとは？CreateObject 関数 FolderExists・GetFolderの使い方
 FileSystemObject CreateObject関数を使う方法・参照設定を使う方法違いを理解してエラー防止

再帰処理とは

再帰処理につきましては、下記ページをご参照ください。

再帰処理とは？指定したフォルダの全ての階層のフォルダ名・サブフォルダ名・ファイル名を取得（Excel VBA）

Callステートメントとは

callステートメントにつきましては、下記ページをご参照ください。

Callステートメントとは
 参照渡し「ByRef」と値渡し「ByVal」の違い（Excel VBA）

【参考】

■■■スポンサーリンク■■■