【VBA】FileSystemObjectでサブフォルダを再帰検索してファイル一覧を取得する方法（コピペOK）

完成イメージ（Before / After）

Before（手作業で1フォルダずつ確認）

After（VBAで全階層を自動一覧化）

5,400フォルダ分の全ファイル一覧が15分で出力される。

実行前の準備

バックアップを取る

本記事のコードはファイルの読み取り専用操作（一覧取得）だが、念のためファイルのコピーを別フォルダに保存してから実行する。

FSOの準備（参照設定 or CreateObject）

FSOを使うには2つの方法がある。

方法1: 参照設定（事前バインディング）

コード補完（IntelliSense）が効くので開発時に便利。

1. VBEのメニュー →「ツール」→「参照設定」
2. 「Microsoft Scripting Runtime」にチェックを入れる
3. 「OK」をクリック

'--- 参照設定方式（コード補完が効く）
Dim fso As New Scripting.FileSystemObject

方法2: CreateObject（実行時バインディング）

参照設定不要。ファイルを他の人に渡す場合に便利。

'--- CreateObject方式（参照設定不要）
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

どちらを使うべきか: 自分だけで使うなら参照設定（コード補完が楽）。他の人にファイルを渡すならCreateObject（相手の参照設定が不要）。本記事のコードはCreateObject方式で書いている。

コード（基本版）– FSOで指定フォルダ直下のファイル一覧を取得

まずはサブフォルダ検索なしの基本版。指定フォルダ直下のファイルだけをイミディエイトウィンドウに出力する。

'============================================================
' ■ FSOでフォルダ直下のファイル一覧を取得（基本版）
'   → 指定フォルダ直下のファイル名をイミディエイトウィンドウに出力
'============================================================
Sub ListFilesBasic()

    '--- ★書き換えポイント ---
    Dim targetPath As String
    targetPath = "C:\Users\Public\Documents\報告書"  '← 対象フォルダのパス
    '--- ★ここまで ---

    '--- FSOオブジェクトを生成
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    '--- フォルダの存在確認
    If Not fso.FolderExists(targetPath) Then
        MsgBox "フォルダが見つかりません。" & vbCrLf & targetPath, vbExclamation
        Exit Sub
    End If

    '--- フォルダ直下のファイルをループ
    Dim folder As Object
    Set folder = fso.GetFolder(targetPath)

    Dim file As Object
    Dim cnt As Long
    cnt = 0

    Debug.Print "===== ファイル一覧（" & targetPath & "）====="
    Debug.Print "No.", "ファイル名", "サイズ(KB)", "更新日"

    For Each file In folder.Files
        cnt = cnt + 1
        Debug.Print cnt, file.Name, _
                   Format(file.Size / 1024, "#,##0"), _
                   Format(file.DateLastModified, "yyyy/mm/dd hh:nn")
    Next file

    Debug.Print "===== 合計: " & cnt & " 件 ====="

    MsgBox cnt & " 件のファイルが見つかりました。" & vbCrLf & _
           "イミディエイトウィンドウ（Ctrl+G）で確認してください。", vbInformation

    Set folder = Nothing
    Set fso = Nothing

End Sub

書き換えポイント

ポイント: FolderExists でフォルダの存在を事前確認している。パスの入力ミスでエラーになるのを防ぐ。ファイル・フォルダの存在確認について詳しくは ファイルやフォルダの存在を確認してから処理する方法 を参照。

コード（応用版）– サブフォルダを再帰的に検索して全ファイルを一覧化

ここが本記事の本題。サブフォルダの中身も含めて全階層のファイルを取得する。

'============================================================
' ■ サブフォルダを再帰検索して全ファイル一覧を取得（応用版）
'   → 全階層のファイルをイミディエイトウィンドウに出力
'============================================================
Sub ListFilesRecursive()

    '--- ★書き換えポイント ---
    Dim targetPath As String
    targetPath = "C:\Users\Public\Documents\報告書"  '← 対象フォルダのパス
    '--- ★ここまで ---

    '--- FSOオブジェクトを生成
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    '--- フォルダの存在確認
    If Not fso.FolderExists(targetPath) Then
        MsgBox "フォルダが見つかりません。" & vbCrLf & targetPath, vbExclamation
        Exit Sub
    End If

    '--- ヘッダー出力
    Debug.Print "===== ファイル一覧（再帰検索）====="
    Debug.Print "No.", "ファイル名", "フォルダ", "サイズ(KB)", "更新日"

    '--- カウンター
    Dim cnt As Long
    cnt = 0

    '--- 再帰検索を開始
    Dim rootFolder As Object
    Set rootFolder = fso.GetFolder(targetPath)
    Call SearchFolder(rootFolder, cnt)

    Debug.Print "===== 合計: " & cnt & " 件 ====="

    MsgBox cnt & " 件のファイルが見つかりました。" & vbCrLf & _
           "イミディエイトウィンドウ（Ctrl+G）で確認してください。", vbInformation

    Set rootFolder = Nothing
    Set fso = Nothing

End Sub

'============================================================
' ■ 再帰プロシージャ（サブフォルダを掘り下げる）
'============================================================
Private Sub SearchFolder(ByVal folder As Object, ByRef cnt As Long)

    '--- このフォルダ内のファイルを出力
    Dim file As Object
    For Each file In folder.Files
        cnt = cnt + 1
        Debug.Print cnt, file.Name, _
                   folder.Path, _
                   Format(file.Size / 1024, "#,##0"), _
                   Format(file.DateLastModified, "yyyy/mm/dd hh:nn")
    Next file

    '--- サブフォルダがあれば再帰呼び出し
    Dim subFolder As Object
    For Each subFolder In folder.SubFolders
        On Error Resume Next  '← アクセス権限のないフォルダをスキップ
        Call SearchFolder(subFolder, cnt)
        On Error GoTo 0
    Next subFolder

End Sub

ポイント: 再帰処理の仕組み

1. SearchFolder はフォルダ内の全ファイルを処理する
2. そのフォルダにサブフォルダがあれば、自分自身（SearchFolder）を呼び出す
3. サブフォルダの中にさらにサブフォルダがあれば、また自分自身を呼び出す
4. これを繰り返すことで、何階層でも自動的に辿れる

On Error Resume Next はアクセス権限のないフォルダ（System Volume Information 等）をスキップするため。これがないとエラーで止まる。

コード（実務版）– 拡張子フィルタ＋更新日フィルタ付きでシートに出力

拡張子フィルタを付けてからは、.xlsxだけ抽出して報告書に使っている。不要なファイルが混ざらないので確認作業もゼロになった。

'============================================================
' ■ 拡張子・更新日フィルタ付き全ファイル一覧をシートに出力（実務版）
'   → サブフォルダを再帰検索し、条件に合うファイルだけ出力
'============================================================
Sub ListFilesWithFilter()

    '--- ★書き換えポイント ---
    Dim targetPath As String
    targetPath = "C:\Users\Public\Documents\報告書"  '← 対象フォルダのパス

    Dim filterExt As String
    filterExt = ".xlsx"        '← 拡張子フィルタ（空欄 "" なら全拡張子）

    Dim filterDays As Long
    filterDays = 30            '← 更新日フィルタ（○日以内。0なら全期間）

    Dim outputSheet As String
    outputSheet = "ファイル一覧"  '← 出力先シート名
    '--- ★ここまで ---

    '--- FSOオブジェクトを生成
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    '--- フォルダの存在確認
    If Not fso.FolderExists(targetPath) Then
        MsgBox "フォルダが見つかりません。" & vbCrLf & targetPath, vbExclamation
        Exit Sub
    End If

    '--- 出力先シートを準備
    Dim wsOut As Worksheet
    On Error Resume Next
    Set wsOut = ThisWorkbook.Worksheets(outputSheet)
    On Error GoTo 0

    If wsOut Is Nothing Then
        Set wsOut = ThisWorkbook.Worksheets.Add
        wsOut.Name = outputSheet
    End If

    '--- シートをクリアしてヘッダーを書き込み
    wsOut.Cells.Clear

    wsOut.Range("A1").Value = "No."
    wsOut.Range("B1").Value = "ファイル名"
    wsOut.Range("C1").Value = "フォルダパス"
    wsOut.Range("D1").Value = "フルパス"
    wsOut.Range("E1").Value = "拡張子"
    wsOut.Range("F1").Value = "サイズ(KB)"
    wsOut.Range("G1").Value = "更新日時"
    wsOut.Range("H1").Value = "作成日時"

    '--- ヘッダー行の書式
    wsOut.Range("A1:H1").Font.Bold = True

    '--- 高速化
    Application.ScreenUpdating = False
    Application.StatusBar = "ファイル検索中..."

    '--- エラー時に ScreenUpdating を確実に復帰させる
    On Error GoTo ErrHandler

    '--- 再帰検索を開始
    Dim outputRow As Long
    outputRow = 2  '← データ開始行

    Dim rootFolder As Object
    Set rootFolder = fso.GetFolder(targetPath)
    Call SearchFolderWithFilter(rootFolder, wsOut, outputRow, filterExt, filterDays)

    '--- 列幅を自動調整
    wsOut.Columns("A:H").AutoFit

    '--- 結果表示
    Dim totalFiles As Long
    totalFiles = outputRow - 2

CleanUp:
    '--- 復帰（正常時もエラー時もここを通る）
    Application.StatusBar = False
    Application.ScreenUpdating = True

    Set rootFolder = Nothing
    Set fso = Nothing

    If totalFiles > 0 Then
        MsgBox "完了しました。" & vbCrLf & vbCrLf & _
               "出力件数: " & totalFiles & " 件" & vbCrLf & _
               "出力先: 「" & outputSheet & "」シート", vbInformation
    ElseIf Err.Number = 0 Then
        MsgBox "条件に合うファイルが見つかりませんでした。" & vbCrLf & _
               "フィルタ条件を確認してください。", vbExclamation
    End If

    Exit Sub

ErrHandler:
    MsgBox "エラーが発生しました。" & vbCrLf & _
           "エラー番号: " & Err.Number & vbCrLf & _
           "内容: " & Err.Description, vbCritical
    Resume CleanUp

End Sub

'============================================================
' ■ 再帰プロシージャ（フィルタ付き）
'============================================================
Private Sub SearchFolderWithFilter(ByVal folder As Object, _
                                    ByVal wsOut As Worksheet, _
                                    ByRef outputRow As Long, _
                                    ByVal filterExt As String, _
                                    ByVal filterDays As Long)

    '--- このフォルダ内のファイルを処理
    Dim file As Object
    For Each file In folder.Files

        '--- 拡張子フィルタ
        If filterExt <> "" Then
            If LCase(Right(file.Name, Len(filterExt))) <> LCase(filterExt) Then
                GoTo NextFile
            End If
        End If

        '--- 更新日フィルタ
        If filterDays > 0 Then
            If DateDiff("d", file.DateLastModified, Now) > filterDays Then
                GoTo NextFile
            End If
        End If

        '--- シートに出力
        wsOut.Cells(outputRow, 1).Value = outputRow - 1       ' No.
        wsOut.Cells(outputRow, 2).Value = file.Name            ' ファイル名
        wsOut.Cells(outputRow, 3).Value = folder.Path          ' フォルダパス
        wsOut.Cells(outputRow, 4).Value = file.Path            ' フルパス
        wsOut.Cells(outputRow, 5).Value = Mid(file.Name, InStrRev(file.Name, ".")) ' 拡張子
        wsOut.Cells(outputRow, 6).Value = Format(file.Size / 1024, "#,##0")  ' サイズ
        wsOut.Cells(outputRow, 7).Value = file.DateLastModified ' 更新日時
        wsOut.Cells(outputRow, 8).Value = file.DateCreated      ' 作成日時

        outputRow = outputRow + 1

        '--- 進捗表示（100件ごと）
        If (outputRow - 2) Mod 100 = 0 Then
            Application.StatusBar = "検索中... " & (outputRow - 2) & " 件取得済み"
            DoEvents
        End If

NextFile:
    Next file

    '--- サブフォルダがあれば再帰呼び出し
    Dim subFolder As Object
    For Each subFolder In folder.SubFolders
        On Error Resume Next
        Call SearchFolderWithFilter(subFolder, wsOut, outputRow, filterExt, filterDays)
        On Error GoTo 0
    Next subFolder

End Sub

書き換えポイント

出力例

「ファイル一覧」シートに以下のように出力される：

取得した一覧をもとにファイルをコピー・移動したい場合は ファイルを別フォルダにコピー・移動する方法 を参照。

よくある落とし穴5選

1. Cドライブ直下を指定してExcelが固まる

自分も最初にやらかした。テストのつもりでCドライブのルートを指定したら、WindowsやProgram Filesの中まで全部辿ってしまい、Excelが15分以上固まった。焦って強制終了したら未保存のコードが消えた。対象フォルダが広すぎると、再帰処理が辿るファイル数が膨大になり、VBAの処理が追いつかなくなる。

対策: 対象フォルダは作業用フォルダなど限定的なパスにする。「パソコンに保存されている全データを検索したい」と思っても、Cドライブ直下は絶対に指定しない。ある程度フォルダを絞ってから実行するのが鉄則。

2. 参照設定を忘れて「ユーザー定義型は定義されていません」エラー

原因: Dim fso As Scripting.FileSystemObject と書いたが、「Microsoft Scripting Runtime」への参照設定がされていない。

対策: VBEメニュー →「ツール」→「参照設定」→「Microsoft Scripting Runtime」にチェック。または本記事のように CreateObject("Scripting.FileSystemObject") を使えば参照設定不要。

3. Dir関数で再帰検索しようとして失敗する

原因: Dir関数はグローバルに状態を保持する。再帰的に呼び出すと、外側のDir呼び出しがリセットされてファイルを取りこぼす。

対策: サブフォルダの再帰検索にはDir関数ではなくFSOを使う。Dir関数は1階層のファイル取得に使う（フォルダ内ファイル一覧を自動取得する方法 参照）。

4. アクセス権限のないフォルダでエラーが出て止まる

原因: ネットワークドライブや共有フォルダで、アクセス権限のないサブフォルダ（System Volume Information 等）に再帰処理が入ろうとする。

対策: 再帰プロシージャ内の For Each subFolder の前後に On Error Resume Next / On Error GoTo 0 を入れてスキップする（応用版・実務版のコードに対策済み）。

5. 隠しファイル（Thumbs.db、desktop.ini）が一覧に混ざる

原因: FSOはデフォルトで全ファイルを取得する。隠しファイルやシステムファイルも区別なく含まれる。

対策: 拡張子フィルタで対象を絞る（実務版コード）。または file.Attributes で隠しファイル（Hidden = 2）を除外する：

'--- 隠しファイルをスキップ（Hidden属性 = 2）
If (file.Attributes And 2) = 0 Then
    '--- ここで処理
End If

VBAのFSOでファイル一覧が取得できないときの対処法

「FSOでフォルダを指定したのにファイルが取得できない」という場合、原因はフォルダパスの末尾に余分なスペースがあるか、パスの指定ミスだ。FolderExists で存在確認し、パスはエクスプローラーからコピペするのが確実。ネットワークフォルダの場合はアクセス権限も確認する。

VBAの再帰処理でExcelが固まるときの対処法

「再帰検索を実行したらExcelが応答なしになった」という場合、原因は対象フォルダが広すぎる（Cドライブ直下など）。対策は対象フォルダを作業用フォルダに限定すること。また DoEvents を適度に入れて「応答なし」表示を防ぐのも効果的だ。

VBA初心者がファイル操作を自動化するときの注意点

これは自分の実体験から強く伝えたいことだが、VBAを始めたばかりのうちは、ファイルを削除するコマンドをプログラムに入れないでほしい。

VBAはファイルのコピーや移動だけでなく、削除も簡単にできてしまう。Kill や DeleteFile を使えば一行でファイルが消える。しかし、VBAで削除したファイルはごみ箱を経由せず、完全に消える。条件の書き間違いで大事なデータが全部消えた、という事故は実際に起こりうる。

特に職場で初めてVBAを導入するとき、自分以外の人もマクロを使う可能性がある。マクロの使い方が分からないまま実行して、意図しないファイルが消えるケースは最悪だ。手順書を用意しても、全員が読むとは限らない。

だから最初は「読み取り専用の操作」だけをVBAに任せるのが安全だ。本記事のコードはすべてファイルの一覧取得（読み取り専用）なので、実行しても元のファイルには何も起こらない。まずはこういった安全な自動化から始めて、VBAの動きに慣れてから、コピーや移動の自動化に進むのがおすすめだ。

ファイルの削除を自動化したい場合は 古いファイルを自動削除する方法 を参照。バックアップの取り方や安全な削除の考え方も解説している。

FAQ

Q1: 参照設定とCreateObjectのどちらを使うべき？

自分だけで使うなら参照設定が便利（コード補完が効く）。他の人にファイルを渡すならCreateObject（相手の環境で参照設定が不要）。本記事のコードはCreateObject方式で書いているので、コピペしてそのまま動く。

Q2: 特定の拡張子だけ取得したい

実務版コードの filterExt を書き換える。

複数の拡張子を指定したい場合は、フィルタ部分を配列で拡張する：

'--- 複数拡張子のフィルタ例
Dim extList As Variant
extList = Array(".xlsx", ".xls", ".csv")

Dim matched As Boolean
matched = False
Dim i As Long
For i = LBound(extList) To UBound(extList)
    If LCase(Right(file.Name, Len(extList(i)))) = LCase(extList(i)) Then
        matched = True
        Exit For
    End If
Next i
If Not matched Then GoTo NextFile

Q3: Dir関数版とFSO版（本記事）の使い分けは？

Dir関数は再帰呼び出しに非対応（リセットされる）。サブフォルダを辿る必要があるならFSO一択。

Q4: ファイル数が多くて処理が遅い場合の対策は？

1. Application.ScreenUpdating = False で画面更新を止める（実務版コードに対策済み）
2. Application.StatusBar で進捗を表示する（実務版コードに対策済み）
3. 対象フォルダを絞る（ルートフォルダではなく、サブフォルダ単位で実行）
4. DoEvents を入れてExcelの「応答なし」を防ぐ（実務版コードに対策済み）

Q5: ネットワークドライブ（\server\share）も対象にできる？

できる。targetPath にUNCパス（"\\server\share\フォルダ名"）を指定する。ただし、アクセス権限のないフォルダがあるとエラーになるため、On Error Resume Next によるスキップ処理が必須（応用版・実務版のコードに対策済み）。ネットワークの速度によっては処理に時間がかかる場合がある。

まとめ

• 基本版: FSOの GetFolder → Files コレクションで指定フォルダ直下のファイルを取得
• 応用版: SubFolders コレクション＋再帰プロシージャで全階層を自動検索
• 実務版: 拡張子フィルタ＋更新日フィルタで必要なファイルだけシートに出力
• FSOの生成: 参照設定（Scripting.FileSystemObject）か CreateObject の2択。配布用はCreateObject
• Dir関数との違い: Dir関数は1階層向き、再帰検索にはFSOを使う
• 安全第一: VBAを始めたばかりのうちは、ファイル削除のコマンドは使わない。読み取り専用の操作から始める

関連記事

• フォルダ内ファイル一覧を自動取得する方法 — Dir関数で1階層のファイルを取得する方法
• ファイルを別フォルダにコピー・移動する方法 — 一覧取得後にファイルを整理したい場合
• 古いファイルを自動削除する方法 — 更新日フィルタの応用で古いファイルを整理
• ファイルやフォルダの存在を確認してから処理する方法 — FSOでの存在チェックの詳細
• 複数Excelファイルを1つに統合する方法 — 一覧取得してからデータを統合する流れ

次にやりたくなること

• ファイルを別フォルダにコピー・移動する方法: 取得したファイル一覧をもとに、条件に合うファイルを別フォルダにコピー・移動する
• 古いファイルを自動削除する方法: 更新日が古いファイルを一覧化した後、不要なファイルを自動削除する
• 複数Excelファイルを1つに統合する方法: 一覧化したファイルのデータをまとめて1つのシートに集約したい場合