フォルダ内のファイル一覧をシートに書き出す（サブフォルダも含めて再帰で取得）

どんな場面で使うか

共有フォルダの容量が増えてきたので不要なファイルを整理したい、各支店から提出されたファイルがそろっているかを確認したい、といった場面では、フォルダの中身を一覧表にできると作業が進めやすくなります。エクスプローラーで1つずつフォルダを開いて確認するのは、階層が深いと大変です。

VBA の FileSystemObject（FSO）を使うと、フォルダ内のファイルの名前・更新日時・サイズを取得できます。さらに「サブフォルダについても同じ処理を呼び出す」という再帰の書き方をすると、階層の深さに関係なくすべてのファイルを一覧にできます。

再帰処理の考え方

再帰とは、ある手続きの中から自分自身を呼び出す書き方です。「フォルダ内のファイルを記録する」→「サブフォルダごとに、同じ手続きを呼び出す」という流れにすると、サブフォルダのさらに下の階層も自動で処理されます。サブフォルダがなくなった時点で呼び出しが終わるため、無限に続くことはありません。

取得した情報はすぐにセルへ書き込まず、Collection にためておき、最後に配列にしてシートへ一括で書き込みます。ファイルが数千件ある場合でも、セルへの書き込みを1回にまとめることで時間を短縮できます。

コード

フォルダを選ばせ、その中のすべてのファイルについて、フォルダのパス・ファイル名・拡張子・更新日時・サイズ（KB）を「ファイル一覧」シートに書き出します。アクセス権のないフォルダは処理を飛ばし、件数をメッセージで知らせます。

Option Explicit

Private skipCnt As Long   ' 読めなかったフォルダの数

Sub ListFiles()
    Dim fso As Object, topFolder As String
    Dim results As Collection, outArr() As Variant
    Dim ws As Worksheet, i As Long, c As Long, rec As Variant

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "一覧にするフォルダを選んでください"
        If .Show <> -1 Then Exit Sub
        topFolder = .SelectedItems(1)
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set results = New Collection
    skipCnt = 0
    Application.StatusBar = "ファイルを調べています..."
    CollectFiles fso.GetFolder(topFolder), results
    Application.StatusBar = False

    Set ws = ThisWorkbook.Worksheets("ファイル一覧")
    ws.Cells.Clear
    ws.Range("A1:E1").Value = Array("フォルダ", "ファイル名", "拡張子", "更新日時", "サイズ(KB)")
    If results.Count = 0 Then
        MsgBox "ファイルが見つかりませんでした"
        Exit Sub
    End If

    ReDim outArr(1 To results.Count, 1 To 5)
    For i = 1 To results.Count
        rec = results(i)
        For c = 0 To 4
            outArr(i, c + 1) = rec(c)
        Next c
    Next i
    ws.Range("A2").Resize(results.Count, 5).Value = outArr
    ws.Columns("D").NumberFormatLocal = "yyyy/mm/dd hh:mm"
    ws.Columns("A:E").AutoFit
    MsgBox results.Count & " 件を書き出しました（読めなかったフォルダ：" & skipCnt & " 件）"
End Sub

' フォルダ内のファイルを記録し、サブフォルダに対して自分自身を呼び出す
Private Sub CollectFiles(ByVal fol As Object, ByVal results As Collection)
    Dim f As Object, subFol As Object, ext As String

    If Not CanRead(fol) Then
        skipCnt = skipCnt + 1
        Exit Sub
    End If

    For Each f In fol.Files
        ext = ""
        If InStrRev(f.Name, ".") > 0 Then ext = LCase(Mid(f.Name, InStrRev(f.Name, ".") + 1))
        results.Add Array(fol.Path, f.Name, ext, f.DateLastModified, Round(f.Size / 1024, 1))
    Next f

    For Each subFol In fol.SubFolders
        CollectFiles subFol, results                 ' 再帰呼び出し
    Next subFol
End Sub

' アクセス権がなく中身を読めないフォルダを判定する
Private Function CanRead(ByVal fol As Object) As Boolean
    Dim n As Long
    On Error Resume Next
    n = fol.Files.Count + fol.SubFolders.Count
    CanRead = (Err.Number = 0)
    On Error GoTo 0
End Function

コードのポイント

FileSystemObject は CreateObject で作成しているため、参照設定をしなくても動きます。ファイルの情報は、Name（ファイル名）、DateLastModified（更新日時）、Size（バイト数）などのプロパティで取得できます。サイズは KB に換算して小数第1位までにしています。

共有フォルダには、アクセス権がなく開けないフォルダが含まれていることがあります。そのままでは「書き込みできません」などのエラーで途中終了するため、CanRead 関数で先に中身を読めるかを確認し、読めないフォルダは飛ばして件数だけを数えています。

注意点

ネットワーク上の共有フォルダで数万件のファイルを調べると、ネットワークの速度によっては数分かかることがあります。最初は小さなフォルダで試し、時間の目安をつかんでから対象を広げてください。処理中はステータスバーに表示を出しているので、止まっているのか処理中なのかを判断できます。

パスの長さが Windows の上限（約260文字）を超えるファイルは、取得できずエラーになる場合があります。また、OneDrive の「オンラインのみ」のファイルは、一覧の取得だけであればダウンロードはされませんが、サイズなどの情報が環境によって異なることがあります。一覧はあくまで実行した時点のものなので、シートに作成日を記録しておくと、後で見返したときに分かりやすくなります。

• 大量のファイルがある場合は小さなフォルダで先に試す
• 読めないフォルダは飛ばして件数を記録する
• パスが長すぎるファイルは取得できないことがある

ほかの記事