【フォルダ階層をリスト化】Excelマクロの便利ツール

2022年5月15日2022年9月28日

フォルダ内が悪魔の巣窟みたいになって困ったことありませんか？

何のデータが入っているかフォルダ名を見ても分からなくなったり。
最新バージョンのファイルが分からなくなったり。

引き継ぎの時にはもっと困りますよね。引き継ぐ方も教えるのが大変だし、引き継がれる方も大変。

そんな困りごとを解決するために、フォルダ/ファイルリストの自動作成ツールを作成しました。

Excelマクロで作成しているので、Excelが入っていれば誰でも使えます。

お手軽にフォルダ/ファイル一覧が作れるので、活用してみてください。

動作内容

説明書を作成したいフォルダを選択してOK
すると、２個目の画像のようにフォルダ/ファイル名の一覧が自動作成されます。

フォルダは先頭に■が付きます。
そして、フォルダは■の数で、ファイルは空白の数で、フォルダ階層の深さが分かるようになっています。

これを全自動で作成してくれます。

これを見れば、どのフォルダに何のファイルが入っているか、ぱっと見で分かりますよね。

あとは、重要なフォルダなどに説明（B列）を書き込めば一覧表の完成です。

C列にフォルダ/ファイルのリンクも自動作成しているため、ワンクリックで目的の場所へと飛ぶこともできます。

ソースコード

FileSystemObjectを使用しているため、「Microsoft Scripting Runtime」の参照設定をしてください。（やり方は下記記事参照）

VBEに下記コードを貼りつけて実行すれば動作します。

Option Explicit
Private fso As FileSystemObject
Private colInfo As Collection
Private Const fldrMark = "■"
Private Const fileMark = "　"
Sub FileDoc()
   'フォルダ/ファイル一覧の自動作成ツール
   'アクティブシート上にフォルダ/ファイル名とリンクを自動生成
   
   'トップフォルダPathの取得
   Dim topFolderPath As String
   With Application.FileDialog(msoFileDialogFolderPicker)
       .Title = "ドキュメント生成したいフォルダを選択"
       .Show
       If .SelectedItems.Count = 0 Then MsgBox "フォルダを選んでください": Exit Sub
       topFolderPath = .SelectedItems(1)
   End With
   
   'インスタンスの生成
   Set fso = New FileSystemObject
   Set colInfo = New Collection
   
   '見出し
   colInfo.Add Split("フォルダorファイル名,説明,リンク", ",")
   
   '再帰的にフォルダおよびファイル情報を取得
   Call WriteInfo(topFolderPath, 1)
   
   'アウトプット
   Application.ScreenUpdating = False '高速化処理
   Dim oneInfo As Variant, row_i As Long
   With ActiveSheet
       For Each oneInfo In colInfo
           row_i = row_i + 1
           '見出しのみ分岐
           If row_i = 1 Then
               .Cells(row_i, 1).Resize(, 3) = oneInfo
           Else
               .Cells(row_i, 1).Resize(, 2) = oneInfo
               .Hyperlinks.Add anchor:=.Cells(row_i, 3), Address:=oneInfo(2), TextToDisplay:=oneInfo(2)
           End If
       Next
       .Columns.AutoFit
   End With
   
   '終了処理
   Application.ScreenUpdating = True
   Set fso = Nothing
   Set colInfo = Nothing
   
End Sub
Private Sub WriteInfo(folderPath As String, stairs As Long)
   'folderPath内のフォルダおよびファイル情報を再帰的にcolInfoへ追加
   'stairsの数だけフォルダ/ファイル名の先頭に■/スペースを入れる
   On Error Resume Next 'アクセス不可能なフォルダ/ファイル対策
   Dim fldr As Object
   Set fldr = fso.GetFolder(folderPath)
   
   'フォルダ情報の取得
   colInfo.Add Array(String(stairs, fldrMark) & fldr.Name, "", fldr.Path)
   
   'ファイル情報の取得
   Dim oneFile As File
   For Each oneFile In fldr.Files
       colInfo.Add Array(String(stairs, fileMark) & oneFile.Name, "", oneFile.Path)
   Next
   
   '再帰処理（下位フォルダ）
   Dim oneFldr As Object
   For Each oneFldr In fldr.SubFolders
       Call WriteInfo(oneFldr.Path, stairs + 1)
   Next
   On Error GoTo 0
   
End Sub