フォルダ一覧をサブフォルダ含めて作成するマクロ(VBA)

2021年6月19日

あれ、あのフォルダってどこに保存したんだっけ?

仕事中にフォルダ探しをしたことありますか?

フォルダを何回層にも作ってしまうと、どこに目的のフォルダがあるか分からなくなることありますよね。

そんな時はフォルダ一覧を作成するマクロを使いましょう

マクロを実行すれば、エクセルシート上にフォルダ一覧を一括表示してくれます。

ちょっと使ってみたいなという方は読んでみてください。

フォルダ一覧を作成するマクロ

Option Explicit
Dim row_i As Long, col As Long

Sub GetFolderList()
'フォルダ一覧をサブフォルダ含めて取得

    Dim strTopFldr As String
    Dim dlg As Object
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    If Not dlg.Show Then Exit Sub'対象のフォルダを選択
    strTopFldr = dlg.SelectedItems(1)
    
    row_i = 1: col = 1
    Cells(row_i, col) = Left(strTopFldr, Len(strTopFldr) - 1)
    GetFolderName (strTopFldr)

End Sub

Private Sub GetFolderName(strPath As String)
'再帰的にフォルダ名をシート上に書き出す

    col = col + 1
    Dim fso As FileSystemObject: Set fso = New FileSystemObject
    Dim fldr As Folder
    With fso
        For Each fldr In .GetFolder(strPath).SubFolders
            '隠しフォルダはスルー
            If Not fldr.Attributes And Hidden Then
                row_i = row_i + 1
                Cells(row_i, col) = fldr.Name
                Call GetFolderName(fldr.Path)
            End If
        Next
    End With
    
    Set fso = Nothing
    col = col - 1
End Sub

このプログラムを実行すると上図のようにフォルダ選択画面が表示されて、フォルダを選択すると下図のように階層ごとにフォルダ一覧が表示されます。

動作内容をざっくりと説明

動作内容をざっくりと説明します。
詳しく知りたい場合はステップ実行をしてみれば、おおよその動きが分かると思います。

    Dim strTopFldr As String
    Dim dlg As Object
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    If Not dlg.Show Then Exit Sub'対象のフォルダを選択
    strTopFldr = dlg.SelectedItems(1)

この部分ではフォルダを選択させています。
strTopFldrは選択したフォルダのフルパスを取得しています。

    row_i = 1: col = 1
    Cells(row_i, col) = Left(strTopFldr, Len(strTopFldr) - 1)
    GetFolderName (strTopFldr)

ここでは選択したフォルダ名をシート上にアウトプットしています。

    With fso
        For Each fldr In .GetFolder(strPath).SubFolders
            '隠しフォルダはスルー
            If Not fldr.Attributes And Hidden Then
                row_i = row_i + 1
                Cells(row_i, col) = fldr.Name
                Call GetFolderName(fldr.Path)
            End If
        Next
    End With

この部分が再帰処理の肝となる部分です。

まず.GetFolder(strPath).SubFoldersでサブフォルダのコレクションを取得しています。

                row_i = row_i + 1
                Cells(row_i, col) = fldr.Name

そして、この部分でフォルダ名をアウトプット。

                Call GetFolderName(fldr.Path)

そしてこのCallで自分自身(プロシージャ)を呼び出しています。再帰呼び出しですね。

この呼び出しによって、「今処理しているフォルダ」のサブフォルダの処理が始まります。
これを延々繰り返すことによって、選択したフォルダのサブフォルダ一覧が作成されます。

フォルダ階層が深くなるにつれて列(col)が増えていくのですが、これは下手に説明するよりこのプログラムをステップ実行した方がよく分かると思います。

一度試してみることをオススメします

他の「VBA」の記事はこちらからどうぞ

VBA

Posted by やろまい