【Excel VBA】FileSystemObjectでサブフォルダを再帰検索する方法（コピペOK）

まず結論：FSOで全階層を走査し、新しいシートへ結果とスキップ理由を出す

サブフォルダを含むファイル一覧をExcelへ出すなら、FileSystemObjectのFilesとSubFoldersを使う。ただし、プロシージャが自分自身を呼ぶ単純な再帰は、深い階層やリンクで止まらなくなる危険がある。この記事の安全版は、未処理フォルダをCollectionへ積む反復方式で、同じ「全階層の走査」を行う。

対象環境はWindows版デスクトップExcelである。 Mac版やブラウザ版Excel向けのコードではない。検索元のファイルは開く・移動・削除しないが、マクロを置いたブックには日時付きの結果シートを1枚追加する。

安全版の動作は次のとおり。

1. ドライブや共有のルート、存在しないパスを開始前に拒否する。
2. 既存シートを消去せず、「一覧_月日時分秒」という新規シートを作る。
3. ファイルは500件ずつまとめて書き込み、セル単位の連続書き込みを減らす。
4. ジャンクションやシンボリックリンクなどの再解析ポイントは辿らず、理由を記録する。
5. アクセスできない項目、深さ上限、件数上限、時間上限を記録し、完全取得と一部取得を区別する。
6. Ctrl+Breakで中止しても、Excelの画面更新・イベント・ステータスバー設定を元へ戻す。

出力前後のイメージ

手作業では、フォルダを開いてファイル名を転記するたびに、見落としや重複が入りやすい。VBAなら、ファイル名、フルパス、サイズ、更新日時などを同じ列構成で並べられる。

処理時間は、ファイル数だけでなく、フォルダ数、ネットワーク遅延、権限、クラウド上のファイル状態、PC性能で変わる。そのため「何件なら何秒」とは断定せず、最初は小さなテストフォルダで測る。

Dir関数・dirコマンド・FSOの使い分け

目的	向く方法	注意点
指定フォルダ直下のファイルだけを取得	VBAのDir関数	短いコードで済む。使い方はフォルダ内のファイル一覧を取得する方法で確認できる
一度だけ全階層のパスをテキストへ出す	Windowsのdirコマンド	ファイルだけなら「dir /s /b /a:-d」を使う。Excel用の属性列やスキップログは自分で整える
全階層を定期走査し、属性・フィルタ・状態をExcelへ出す	FSO	リンク、アクセス拒否、行上限、処理中の変更を考慮する必要がある

実行前に決める安全境界

検索元は業務用の子フォルダへ限定する

Cドライブ直下、ユーザーフォルダ全体、共有サーバーの共有名直下は指定しない。対象範囲を説明できる子フォルダを選ぶ。コードもドライブと共有のルートを拒否するが、正しいフォルダを選ぶ責任まで自動化できるわけではない。

マクロはコピーしたブックで試す

検索元のファイルは変更しないが、実行ブックには新しい結果シートを追加する。重要な数式やマクロを含むブックへいきなり貼らず、コピーしたマクロ有効ブックで確認する。既存の「ファイル一覧」シートを再利用・全消去する処理は含めていない。

リンクとクラウド領域は既定で辿らない

Windowsの再解析ポイントは、別の場所を指すジャンクション、シンボリックリンク、クラウドのプレースホルダーなどに使われる。リンクを無条件に辿ると、同じ実体を繰り返したり、想定外の領域へ入ったりする。安全版は属性1024のファイル・フォルダをスキップし、K～M列へ記録する。

上限で止まることを失敗と混同しない

初期値では、最大50,000フォルダ、200,000走査ファイル、100,000出力行、深さ50、実行900秒を安全境界にする。これは性能保証や推奨保持数ではなく、範囲指定ミスを無制限走査にしないための開始値である。フォルダ数、走査ファイル数、出力行数、実行時間の上限到達時はSTOPPED_LIMITとなる。深さ上限を超えたフォルダは問題欄へ記録され、ほかの停止上限に達しなければStatusはPARTIALとなる。どちらも完全な一覧として扱わない。

コピペ用：サブフォルダを安全に全階層走査するVBA

次のコードを標準モジュールへまとめて貼る。最初に変更するのはTARGET_FOLDER、FILTER_EXTENSION、UPDATED_WITHIN_DAYSの3項目である。コードは参照設定不要の実行時バインディングを使う。

Option Explicit

Private Const TARGET_FOLDER As String = "C:\Work\検査記録"
Private Const FILTER_EXTENSION As String = ".xlsx"
Private Const UPDATED_WITHIN_DAYS As Long = 0
Private Const INCLUDE_HIDDEN_SYSTEM As Boolean = False

Private Const MAX_FOLDERS_TO_SCAN As Long = 50000
Private Const MAX_FILES_TO_SCAN As Long = 200000
Private Const MAX_FILES_TO_OUTPUT As Long = 100000
Private Const MAX_DEPTH As Long = 50
Private Const MAX_RUNTIME_SECONDS As Long = 900
Private Const MAX_ISSUES_TO_LIST As Long = 10000

Private Const REPARSE_POINT_ATTRIBUTE As Long = 1024
Private Const HIDDEN_ATTRIBUTE As Long = 2
Private Const SYSTEM_ATTRIBUTE As Long = 4

Private Const HEADER_ROW As Long = 7
Private Const FIRST_DATA_ROW As Long = 8
Private Const FIRST_ISSUE_ROW As Long = 8
Private Const OUTPUT_COLUMN_COUNT As Long = 9
Private Const OUTPUT_BATCH_SIZE As Long = 500
Private Const EXCEL_CELL_TEXT_LIMIT As Long = 32767

Private mFso As Object
Private mOutput As Worksheet

Private mFileRow As Long
Private mIssueRow As Long
Private mScannedFolderCount As Long
Private mQueuedFolderCount As Long
Private mScannedFileCount As Long
Private mOutputFileCount As Long
Private mFilteredFileCount As Long
Private mIssueCount As Long

Private mStartedAt As Date
Private mModifiedCutoff As Date
Private mFilterExtension As String
Private mStopScan As Boolean
Private mCancelled As Boolean
Private mStopReason As String
Private mIsRunning As Boolean
Private mOutputWriteInProgress As Boolean
Private mBufferMutationInProgress As Boolean

Private mBuffer() As Variant
Private mBufferCount As Long

Public Sub CreateRecursiveFileList()

    Dim pendingFolders As Collection
    Dim pendingItem As Variant
    Dim rootFolder As Object
    Dim targetPath As String
    Dim resultStatus As String

    Dim previousScreenUpdating As Boolean
    Dim previousEnableEvents As Boolean
    Dim previousEnableCancelKey As Variant
    Dim previousStatusBar As Variant

    Dim errNumber As Long
    Dim errDescription As String
    Dim outputWriteFailed As Boolean

    If mIsRunning Then
        MsgBox "同じマクロが既に実行中です。", vbExclamation
        Exit Sub
    End If

    mIsRunning = True
    On Error GoTo FatalError

    previousScreenUpdating = Application.ScreenUpdating
    previousEnableEvents = Application.EnableEvents
    previousEnableCancelKey = Application.EnableCancelKey
    previousStatusBar = Application.StatusBar

    ResetScanState
    ValidateSettings

    Set mFso = CreateObject("Scripting.FileSystemObject")
    targetPath = NormalizeTargetPath(mFso, TARGET_FOLDER)

    If Not mFso.FolderExists(targetPath) Then
        Err.Raise vbObjectError + 3100, _
                  "CreateRecursiveFileList", _
                  "対象フォルダが見つかりません: " & targetPath
    End If

    If IsStorageRoot(mFso, targetPath) Then
        Err.Raise vbObjectError + 3101, _
                  "CreateRecursiveFileList", _
                  "ドライブや共有のルートは指定できません。"
    End If

    Set rootFolder = mFso.GetFolder(targetPath)

    If IsReparseFolder(rootFolder) Then
        Err.Raise vbObjectError + 3102, _
                  "CreateRecursiveFileList", _
                  "対象フォルダ自体が再解析ポイントです。" & _
                  "実体側の子フォルダを指定してください。"
    End If

    If MsgBox( _
        "次のフォルダを読み取り専用で走査します。" & vbCrLf & _
        targetPath & vbCrLf & vbCrLf & _
        "結果はこのブックの新しいシートへ出力します。", _
        vbOKCancel + vbInformation, _
        "ファイル一覧の作成") <> vbOK Then

        GoTo CleanExit
    End If

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.EnableCancelKey = xlErrorHandler

    mStartedAt = Now
    If UPDATED_WITHIN_DAYS > 0 Then
        mModifiedCutoff = _
            DateAdd("d", -UPDATED_WITHIN_DAYS, mStartedAt)
    End If

    Set mOutput = CreateUniqueOutputSheet
    SetupOutputSheet targetPath

    Set pendingFolders = New Collection
    pendingFolders.Add Array(targetPath, CLng(0))
    mQueuedFolderCount = 1

    Do While pendingFolders.Count > 0 And Not mStopScan

        pendingItem = pendingFolders.Item(pendingFolders.Count)
        pendingFolders.Remove pendingFolders.Count

        ProcessOneFolder _
            CStr(pendingItem(0)), _
            CLng(pendingItem(1)), _
            pendingFolders

        CheckGlobalLimits

    Loop

FinishScan:
    FlushOutputBuffer

    If mCancelled Then
        resultStatus = "CANCELLED"
    ElseIf mStopScan Then
        resultStatus = "STOPPED_LIMIT"
    ElseIf mIssueCount > 0 Then
        resultStatus = "PARTIAL"
    Else
        resultStatus = "COMPLETE"
    End If

    FinalizeOutputSheet resultStatus
    ShowScanResult resultStatus
    GoTo CleanExit

FatalError:
    errNumber = Err.Number
    errDescription = Err.Description

    outputWriteFailed = _
        (mOutputWriteInProgress Or _
         mBufferMutationInProgress)

    mOutputWriteInProgress = False
    mBufferMutationInProgress = False

    If errNumber = 18 And _
       Not mOutput Is Nothing And _
       Not outputWriteFailed Then

        mCancelled = True
        mStopScan = True
        mStopReason = "ユーザーがCtrl+Breakで中止しました。"
        Resume FinishScan
    End If

    On Error Resume Next

    If Not mOutput Is Nothing Then
        If Not outputWriteFailed Then
            FlushOutputBuffer
        End If

        mOutput.Range("B1").Value = "FAILED"
        mOutput.Range("B4").Value = Now
        mOutput.Range("B6").Value = _
            "エラー " & errNumber & ": " & errDescription
    End If

    On Error GoTo 0

    MsgBox "一覧作成を完了できませんでした。" & vbCrLf & _
           "エラー番号: " & errNumber & vbCrLf & _
           "内容: " & errDescription, vbCritical

CleanExit:
    Application.StatusBar = previousStatusBar
    Application.EnableCancelKey = previousEnableCancelKey
    Application.EnableEvents = previousEnableEvents
    Application.ScreenUpdating = previousScreenUpdating

    Set rootFolder = Nothing
    Set pendingFolders = Nothing
    Set mOutput = Nothing
    Set mFso = Nothing

    Erase mBuffer
    mOutputWriteInProgress = False
    mBufferMutationInProgress = False
    mIsRunning = False

End Sub

Private Sub ResetScanState()

    Set mFso = Nothing
    Set mOutput = Nothing

    mFileRow = FIRST_DATA_ROW
    mIssueRow = FIRST_ISSUE_ROW
    mScannedFolderCount = 0
    mQueuedFolderCount = 0
    mScannedFileCount = 0
    mOutputFileCount = 0
    mFilteredFileCount = 0
    mIssueCount = 0

    mStartedAt = 0
    mModifiedCutoff = 0
    mFilterExtension = ""
    mStopScan = False
    mCancelled = False
    mStopReason = ""
    mOutputWriteInProgress = False
    mBufferMutationInProgress = False

    mBufferCount = 0
    ReDim mBuffer(1 To OUTPUT_BATCH_SIZE, _
                  1 To OUTPUT_COLUMN_COUNT)

End Sub

Private Sub ValidateSettings()

    If UPDATED_WITHIN_DAYS < 0 Then
        Err.Raise vbObjectError + 3110, _
                  "ValidateSettings", _
                  "UPDATED_WITHIN_DAYSは0以上にしてください。"
    End If

    If MAX_FOLDERS_TO_SCAN < 1 Or _
       MAX_FILES_TO_SCAN < 1 Or _
       MAX_FILES_TO_OUTPUT < 1 Or _
       MAX_DEPTH < 1 Or _
       MAX_RUNTIME_SECONDS < 1 Then

        Err.Raise vbObjectError + 3111, _
                  "ValidateSettings", _
                  "安全上限はすべて1以上にしてください。"
    End If

    mFilterExtension = _
        NormalizeExtension(FILTER_EXTENSION)

End Sub

Private Function NormalizeExtension( _
    ByVal rawExtension As String) As String

    Dim normalized As String

    normalized = LCase$(Trim$(rawExtension))

    If Len(normalized) = 0 Then
        NormalizeExtension = ""
        Exit Function
    End If

    If Left$(normalized, 1) = "." Then
        normalized = Mid$(normalized, 2)
    End If

    If Len(normalized) = 0 Or _
       InStr(normalized, "\") > 0 Or _
       InStr(normalized, "/") > 0 Or _
       InStr(normalized, "*") > 0 Or _
       InStr(normalized, "?") > 0 Then

        Err.Raise vbObjectError + 3112, _
                  "NormalizeExtension", _
                  "拡張子は .xlsx のように1種類だけ指定してください。"
    End If

    NormalizeExtension = normalized

End Function

Private Function NormalizeTargetPath( _
    ByVal fso As Object, _
    ByVal rawPath As String) As String

    Dim normalized As String

    normalized = Trim$(rawPath)

    If Len(normalized) = 0 Then
        Err.Raise vbObjectError + 3120, _
                  "NormalizeTargetPath", _
                  "対象フォルダを指定してください。"
    End If

    If InStr(normalized, "*") > 0 Or _
       InStr(normalized, "?") > 0 Then

        Err.Raise vbObjectError + 3121, _
                  "NormalizeTargetPath", _
                  "ワイルドカードを含むパスは指定できません。"
    End If

    If Not IsAbsoluteWindowsPath(normalized) Then
        Err.Raise vbObjectError + 3122, _
                  "NormalizeTargetPath", _
                  "ドライブ名またはUNC共有名から始まる" & _
                  "絶対パスを指定してください。"
    End If

    normalized = fso.GetAbsolutePathName(normalized)

    Do While Len(normalized) > 3 And _
             Right$(normalized, 1) = "\"

        normalized = Left$(normalized, Len(normalized) - 1)
    Loop

    NormalizeTargetPath = normalized

End Function

Private Function IsAbsoluteWindowsPath( _
    ByVal folderPath As String) As Boolean

    Dim separatorPosition As Long
    Dim driveLetter As String

    If Left$(folderPath, 2) = "\\" Then
        separatorPosition = InStr(3, folderPath, "\")
        IsAbsoluteWindowsPath = _
            (separatorPosition > 3 And _
             Len(folderPath) > separatorPosition)
        Exit Function
    End If

    If Len(folderPath) < 3 Then Exit Function

    driveLetter = UCase$(Left$(folderPath, 1))

    IsAbsoluteWindowsPath = _
        (driveLetter >= "A" And driveLetter <= "Z" And _
         Mid$(folderPath, 2, 2) = ":\")

End Function

Private Function IsStorageRoot( _
    ByVal fso As Object, _
    ByVal folderPath As String) As Boolean

    Dim normalized As String
    Dim driveName As String

    normalized = NormalizeTargetPath(fso, folderPath)
    driveName = fso.GetDriveName(normalized)

    Do While Len(normalized) > 2 And _
             Right$(normalized, 1) = "\"

        normalized = Left$(normalized, Len(normalized) - 1)
    Loop

    Do While Len(driveName) > 2 And _
             Right$(driveName, 1) = "\"

        driveName = Left$(driveName, Len(driveName) - 1)
    Loop

    IsStorageRoot = _
        (StrComp(normalized, driveName, vbTextCompare) = 0)

End Function

Private Sub ProcessOneFolder( _
    ByVal folderPath As String, _
    ByVal depth As Long, _
    ByVal pendingFolders As Collection)

    Dim folder As Object
    Dim errNumber As Long
    Dim errDescription As String

    On Error GoTo FolderError

    If mStopScan Then Exit Sub

    If depth > MAX_DEPTH Then
        LogIssue "フォルダ", folderPath, _
                 "深さ上限を超えたため未走査"
        Exit Sub
    End If

    Set folder = mFso.GetFolder(folderPath)

    If IsReparseFolder(folder) Then
        LogIssue "フォルダ", folderPath, _
                 "再解析ポイントのため未走査"
        Exit Sub
    End If

    mScannedFolderCount = mScannedFolderCount + 1

    ProcessFilesInFolder folder, folderPath, depth

    If Not mStopScan Then
        QueueChildFolders _
            folder, folderPath, depth + 1, pendingFolders
    End If

    Set folder = Nothing
    Exit Sub

FolderError:
    errNumber = Err.Number
    errDescription = Err.Description

    If mOutputWriteInProgress Or _
       mBufferMutationInProgress Then

        Err.Raise errNumber, _
                  "ProcessOneFolder", errDescription
    End If

    HandleScanError "フォルダ", folderPath, _
                    errNumber, errDescription

End Sub

Private Sub ProcessFilesInFolder( _
    ByVal folder As Object, _
    ByVal folderPath As String, _
    ByVal depth As Long)

    Dim file As Object
    Dim errNumber As Long
    Dim errDescription As String

    On Error GoTo FilesError

    For Each file In folder.Files

        If mStopScan Then Exit For

        If mScannedFileCount >= MAX_FILES_TO_SCAN Then
            StopAtLimit _
                "走査ファイル上限 " & _
                MAX_FILES_TO_SCAN & " 件に達しました。"
            Exit For
        End If

        mScannedFileCount = mScannedFileCount + 1
        TryAddFileToOutput file, folderPath, depth

        If mScannedFileCount Mod 100 = 0 Then
            CheckGlobalLimits
        End If

    Next file

    Set file = Nothing
    Exit Sub

FilesError:
    errNumber = Err.Number
    errDescription = Err.Description

    If mOutputWriteInProgress Or _
       mBufferMutationInProgress Then

        Err.Raise errNumber, _
                  "ProcessFilesInFolder", errDescription
    End If

    HandleScanError "ファイル列挙", folderPath, _
                    errNumber, errDescription

End Sub

Private Sub QueueChildFolders( _
    ByVal folder As Object, _
    ByVal folderPath As String, _
    ByVal nextDepth As Long, _
    ByVal pendingFolders As Collection)

    Dim subFolder As Object
    Dim errNumber As Long
    Dim errDescription As String

    On Error GoTo ChildrenError

    For Each subFolder In folder.SubFolders

        If mStopScan Then Exit For

        TryQueueChildFolder _
            subFolder, nextDepth, pendingFolders

        If mQueuedFolderCount Mod 100 = 0 Then
            CheckGlobalLimits
        End If

    Next subFolder

    Set subFolder = Nothing
    Exit Sub

ChildrenError:
    errNumber = Err.Number
    errDescription = Err.Description

    If mOutputWriteInProgress Or _
       mBufferMutationInProgress Then

        Err.Raise errNumber, _
                  "QueueChildFolders", errDescription
    End If

    HandleScanError "サブフォルダ列挙", _
                    folderPath, _
                    errNumber, errDescription

End Sub

Private Sub TryQueueChildFolder( _
    ByVal subFolder As Object, _
    ByVal nextDepth As Long, _
    ByVal pendingFolders As Collection)

    Dim subFolderPath As String
    Dim attributes As Long
    Dim errNumber As Long
    Dim errDescription As String

    On Error GoTo ChildError

    subFolderPath = subFolder.Path
    attributes = CLng(subFolder.Attributes)

    If (attributes And REPARSE_POINT_ATTRIBUTE) <> 0 Then
        LogIssue "フォルダ", subFolderPath, _
                 "再解析ポイントのため未走査"
        Exit Sub
    End If

    If Not INCLUDE_HIDDEN_SYSTEM Then
        If (attributes And _
            (HIDDEN_ATTRIBUTE Or SYSTEM_ATTRIBUTE)) <> 0 Then

            LogIssue "フォルダ", subFolderPath, _
                     "隠し属性またはシステム属性のため未走査"
            Exit Sub
        End If
    End If

    If nextDepth > MAX_DEPTH Then
        LogIssue "フォルダ", subFolderPath, _
                 "深さ上限を超えたため未走査"
        Exit Sub
    End If

    If mQueuedFolderCount >= MAX_FOLDERS_TO_SCAN Then
        StopAtLimit _
            "フォルダ上限 " & _
            MAX_FOLDERS_TO_SCAN & " 件に達しました。"
        Exit Sub
    End If

    pendingFolders.Add Array(subFolderPath, nextDepth)
    mQueuedFolderCount = mQueuedFolderCount + 1
    Exit Sub

ChildError:
    errNumber = Err.Number
    errDescription = Err.Description

    If mOutputWriteInProgress Or _
       mBufferMutationInProgress Then

        Err.Raise errNumber, _
                  "TryQueueChildFolder", errDescription
    End If

    If Len(subFolderPath) = 0 Then
        subFolderPath = "（パス取得前）"
    End If

    HandleScanError "サブフォルダ", subFolderPath, _
                    errNumber, errDescription

End Sub

Private Function TryAddFileToOutput( _
    ByVal file As Object, _
    ByVal folderPath As String, _
    ByVal depth As Long) As Boolean

    Dim fileName As String
    Dim filePath As String
    Dim extensionName As String
    Dim attributes As Long
    Dim fileSize As Variant
    Dim modifiedAt As Date
    Dim createdAt As Date
    Dim errNumber As Long
    Dim errDescription As String

    On Error GoTo FileError

    filePath = folderPath & "\（名前取得前）"
    fileName = file.Name
    filePath = file.Path
    attributes = CLng(file.Attributes)

    If (attributes And REPARSE_POINT_ATTRIBUTE) <> 0 Then
        LogIssue "ファイル", filePath, _
                 "再解析ポイントのため未出力"
        Exit Function
    End If

    If Not INCLUDE_HIDDEN_SYSTEM Then
        If (attributes And _
            (HIDDEN_ATTRIBUTE Or SYSTEM_ATTRIBUTE)) <> 0 Then

            mFilteredFileCount = mFilteredFileCount + 1
            Exit Function
        End If
    End If

    extensionName = mFso.GetExtensionName(fileName)

    If Len(mFilterExtension) > 0 Then
        If StrComp(extensionName, _
                   mFilterExtension, _
                   vbTextCompare) <> 0 Then

            mFilteredFileCount = mFilteredFileCount + 1
            Exit Function
        End If
    End If

    modifiedAt = file.DateLastModified

    If UPDATED_WITHIN_DAYS > 0 Then
        If modifiedAt < mModifiedCutoff Then

            mFilteredFileCount = mFilteredFileCount + 1
            Exit Function
        End If
    End If

    If mOutputFileCount >= MAX_FILES_TO_OUTPUT Then
        StopAtLimit _
            "出力ファイル上限 " & _
            MAX_FILES_TO_OUTPUT & " 件に達しました。"
        Exit Function
    End If

    If FIRST_DATA_ROW + mOutputFileCount > _
       mOutput.Rows.Count Then

        StopAtLimit "Excelシートの行上限に達しました。"
        Exit Function
    End If

    fileSize = file.Size
    createdAt = file.DateCreated

    If Len(filePath) > EXCEL_CELL_TEXT_LIMIT Then
        LogIssue "ファイル", CellSafeText(filePath), _
                 "セル上限のためフルパスを短縮して出力"
    End If

    mBufferMutationInProgress = True

    mBufferCount = mBufferCount + 1
    mOutputFileCount = mOutputFileCount + 1

    mBuffer(mBufferCount, 1) = mOutputFileCount
    mBuffer(mBufferCount, 2) = CellSafeText(fileName)
    mBuffer(mBufferCount, 3) = extensionName
    mBuffer(mBufferCount, 4) = CellSafeText(folderPath)
    mBuffer(mBufferCount, 5) = CellSafeText(filePath)
    mBuffer(mBufferCount, 6) = fileSize
    mBuffer(mBufferCount, 7) = modifiedAt
    mBuffer(mBufferCount, 8) = createdAt
    mBuffer(mBufferCount, 9) = depth

    mBufferMutationInProgress = False

    If mBufferCount = OUTPUT_BATCH_SIZE Then
        FlushOutputBuffer
    End If

    TryAddFileToOutput = True
    Exit Function

FileError:
    errNumber = Err.Number
    errDescription = Err.Description

    If mOutputWriteInProgress Or _
       mBufferMutationInProgress Then

        Err.Raise errNumber, _
                  "TryAddFileToOutput", errDescription
    End If

    HandleScanError "ファイル", filePath, _
                    errNumber, errDescription

End Function

Private Sub FlushOutputBuffer()

    Dim partialData() As Variant
    Dim rowIndex As Long
    Dim columnIndex As Long

    If mBufferCount = 0 Then Exit Sub

    mOutputWriteInProgress = True

    If mBufferCount = OUTPUT_BATCH_SIZE Then
        mOutput.Cells(mFileRow, 1). _
            Resize(mBufferCount, OUTPUT_COLUMN_COUNT).Value = _
            mBuffer
    Else
        ReDim partialData(1 To mBufferCount, _
                          1 To OUTPUT_COLUMN_COUNT)

        For rowIndex = 1 To mBufferCount
            For columnIndex = 1 To OUTPUT_COLUMN_COUNT
                partialData(rowIndex, columnIndex) = _
                    mBuffer(rowIndex, columnIndex)
            Next columnIndex
        Next rowIndex

        mOutput.Cells(mFileRow, 1). _
            Resize(mBufferCount, OUTPUT_COLUMN_COUNT).Value = _
            partialData
    End If

    mFileRow = mFileRow + mBufferCount
    mBufferCount = 0
    mOutputWriteInProgress = False

End Sub

Private Sub CheckGlobalLimits()

    If mStopScan Then Exit Sub

    If DateDiff("s", mStartedAt, Now) >= _
       MAX_RUNTIME_SECONDS Then

        StopAtLimit _
            "実行時間上限 " & _
            MAX_RUNTIME_SECONDS & " 秒に達しました。"
        Exit Sub
    End If

    Application.StatusBar = _
        "走査中: フォルダ " & mScannedFolderCount & _
        " / ファイル " & mScannedFileCount & _
        " / 出力 " & mOutputFileCount

    DoEvents

End Sub

Private Sub StopAtLimit(ByVal reasonText As String)

    If Not mStopScan Then
        mStopScan = True
        mStopReason = reasonText
    End If

End Sub

Private Sub HandleScanError( _
    ByVal itemType As String, _
    ByVal itemPath As String, _
    ByVal errNumber As Long, _
    ByVal errDescription As String)

    If errNumber = 18 Then
        mCancelled = True
        mStopScan = True
        mStopReason = "ユーザーがCtrl+Breakで中止しました。"
        Exit Sub
    End If

    LogIssue itemType, itemPath, _
             "エラー " & errNumber & ": " & errDescription

End Sub

Private Sub LogIssue( _
    ByVal itemType As String, _
    ByVal itemPath As String, _
    ByVal reasonText As String)

    mIssueCount = mIssueCount + 1

    If mIssueCount > MAX_ISSUES_TO_LIST Then Exit Sub
    If mIssueRow > mOutput.Rows.Count Then Exit Sub

    mOutputWriteInProgress = True

    mOutput.Cells(mIssueRow, 11).Value = itemType
    mOutput.Cells(mIssueRow, 12).Value = _
        CellSafeText(itemPath)
    mOutput.Cells(mIssueRow, 13).Value = _
        CellSafeText(reasonText)

    mIssueRow = mIssueRow + 1
    mOutputWriteInProgress = False

End Sub

Private Function IsReparseFolder( _
    ByVal folder As Object) As Boolean

    IsReparseFolder = _
        ((CLng(folder.Attributes) And _
          REPARSE_POINT_ATTRIBUTE) <> 0)

End Function

Private Function CreateUniqueOutputSheet() As Worksheet

    Dim baseName As String
    Dim candidateName As String
    Dim attempt As Long
    Dim ws As Worksheet

    baseName = "一覧_" & Format$(Now, "mmdd_hhnnss")

    For attempt = 0 To 999

        If attempt = 0 Then
            candidateName = baseName
        Else
            candidateName = _
                baseName & "_" & Format$(attempt, "000")
        End If

        If Not WorksheetExists(candidateName) Then
            Set ws = ThisWorkbook.Worksheets.Add( _
                After:=ThisWorkbook.Worksheets( _
                    ThisWorkbook.Worksheets.Count))

            ws.Name = candidateName
            Set CreateUniqueOutputSheet = ws
            Exit Function
        End If

    Next attempt

    Err.Raise vbObjectError + 3130, _
              "CreateUniqueOutputSheet", _
              "一意な出力シート名を作成できません。"

End Function

Private Function WorksheetExists( _
    ByVal sheetName As String) As Boolean

    Dim ws As Worksheet

    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(sheetName)
    WorksheetExists = Not ws Is Nothing
    On Error GoTo 0

    Set ws = Nothing

End Function

Private Sub SetupOutputSheet(ByVal targetPath As String)

    Dim availableDataRows As Long
    Dim availableIssueRows As Long
    Dim lastTextDataRow As Long
    Dim lastTextIssueRow As Long

    mOutputWriteInProgress = True

    availableDataRows = _
        mOutput.Rows.Count - FIRST_DATA_ROW + 1

    If MAX_FILES_TO_OUTPUT > availableDataRows Then
        lastTextDataRow = mOutput.Rows.Count
    Else
        lastTextDataRow = _
            FIRST_DATA_ROW + MAX_FILES_TO_OUTPUT - 1
    End If

    availableIssueRows = _
        mOutput.Rows.Count - FIRST_ISSUE_ROW + 1

    If MAX_ISSUES_TO_LIST > availableIssueRows Then
        lastTextIssueRow = mOutput.Rows.Count
    Else
        lastTextIssueRow = _
            FIRST_ISSUE_ROW + MAX_ISSUES_TO_LIST - 1
    End If

    With mOutput
        .Range("B" & FIRST_DATA_ROW & _
               ":E" & lastTextDataRow).NumberFormat = "@"
        .Range("K" & FIRST_ISSUE_ROW & _
               ":M" & lastTextIssueRow).NumberFormat = "@"

        .Range("A1").Value = "Status"
        .Range("B1").Value = "RUNNING"
        .Range("A2").Value = "Target"
        .Range("B2").Value = targetPath
        .Range("A3").Value = "StartedAt"
        .Range("B3").Value = mStartedAt
        .Range("A4").Value = "FinishedAt"
        .Range("A5").Value = "Counts"
        .Range("A6").Value = "StopReason"

        .Range("A7:I7").Value = Array( _
            "No.", "ファイル名", "拡張子", _
            "フォルダパス", "フルパス", "サイズ(Bytes)", _
            "更新日時", "作成日時", "階層")

        .Range("K7:M7").Value = Array( _
            "対象種別", "対象パス", "スキップ・エラー理由")

        .Range("A1:A6").Font.Bold = True
        .Range("A7:I7").Font.Bold = True
        .Range("K7:M7").Font.Bold = True
        .Range("B3:B4").NumberFormat = "yyyy/mm/dd hh:mm:ss"
    End With

    mOutputWriteInProgress = False

End Sub

Private Sub FinalizeOutputSheet( _
    ByVal resultStatus As String)

    Dim lastDataRow As Long

    lastDataRow = mFileRow - 1

    With mOutput
        .Range("B1").Value = resultStatus
        .Range("B4").Value = Now
        .Range("B5").Value = _
            "folders=" & mScannedFolderCount & _
            ", scanned_files=" & mScannedFileCount & _
            ", output_files=" & mOutputFileCount & _
            ", filtered_files=" & mFilteredFileCount & _
            ", issues=" & mIssueCount
        .Range("B6").Value = mStopReason

        .Range("A7:I7").AutoFilter

        If lastDataRow >= FIRST_DATA_ROW Then
            .Range("F8:F" & lastDataRow).NumberFormat = "#,##0"
            .Range("G8:H" & lastDataRow).NumberFormat = _
                "yyyy/mm/dd hh:mm:ss"
        End If

        .Columns("A").ColumnWidth = 10
        .Columns("B").ColumnWidth = 30
        .Columns("C").ColumnWidth = 12
        .Columns("D:E").ColumnWidth = 45
        .Columns("F:I").ColumnWidth = 18
        .Columns("K").ColumnWidth = 16
        .Columns("L:M").ColumnWidth = 45

        If mIssueCount > MAX_ISSUES_TO_LIST Then
            .Range("K4").Value = _
                "問題は先頭 " & MAX_ISSUES_TO_LIST & _
                " 件だけ表示しています。"
        End If

        .Range("B1").Font.Bold = True
    End With

End Sub

Private Sub ShowScanResult(ByVal resultStatus As String)

    Dim messageText As String
    Dim messageStyle As VbMsgBoxStyle

    messageText = _
        "状態: " & resultStatus & vbCrLf & _
        "走査フォルダ: " & mScannedFolderCount & vbCrLf & _
        "走査ファイル: " & mScannedFileCount & vbCrLf & _
        "出力ファイル: " & mOutputFileCount & vbCrLf & _
        "問題・スキップ: " & mIssueCount & vbCrLf & _
        "出力先: " & mOutput.Name

    If Len(mStopReason) > 0 Then
        messageText = messageText & vbCrLf & vbCrLf & _
                      "停止理由: " & mStopReason
    End If

    If resultStatus = "COMPLETE" Then
        messageStyle = vbInformation
    Else
        messageStyle = vbExclamation
        messageText = messageText & vbCrLf & vbCrLf & _
            "完全な一覧として扱わず、K～M列を確認してください。"
    End If

    MsgBox messageText, messageStyle

End Sub

Private Function CellSafeText( _
    ByVal textValue As String) As String

    Const SUFFIX As String = "...[truncated]"

    If Len(textValue) <= EXCEL_CELL_TEXT_LIMIT Then
        CellSafeText = textValue
    Else
        CellSafeText = _
            Left$(textValue, _
                  EXCEL_CELL_TEXT_LIMIT - Len(SUFFIX)) & SUFFIX
    End If

End Function

このコードが変更するもの・変更しないもの

このマクロは検索元を読み取り、実行中のブックへ結果を追加する。検索元のファイルを開いたり、名前を変えたり、コピー・移動・削除したりはしない。一方で、結果シートを追加するため、マクロを入れたブックには変更が生じる。「元ファイルを変更しない」と「ブックを一切変更しない」は別なので、初回は原本ではなくコピーしたマクロ有効ブックで試す。

対象	行うこと	行わないこと
検索元のファイル	名前、フルパス、拡張子、サイズ、日時、属性を読む	開く、保存する、内容を書き換える、コピー・移動・削除する
検索元のフォルダ	直下のFilesとSubFoldersを列挙する	作成、名称変更、移動、削除、権限変更を行う
既存ワークシート	同名回避のためシート名だけを確認する	Cells.Clear、行削除、シート削除、既存データへの上書きを行う
実行中のブック	一意な名前の結果シートを1枚追加する	自動保存、別形式への変換、以前の結果シートの自動削除を行う
外部サービス	何も送信しない	クラウドAPI、メール、Webサイトへ結果を書き込む

マクロの完了後もブックは自動保存されない。結果シートが作成された場合は、表示されているStatus、Counts、K～M列の問題記録を確認し、結果が必要な場合だけ利用者が保存する。CANCELLED、STOPPED_LIMIT、PARTIALでは途中結果が残る。FAILEDは発生箇所により、結果シートが残る場合と作成されない場合がある。結果シートが残った場合は、ブックを閉じる前に「参考用として保存するか」「保存せず破棄するか」を決める。検索結果を次のコピー・移動・削除処理へ自動連携させる機能は含めていない。

マクロを入れたブックが検索元フォルダの内側に保存されている場合、そのブック自身も条件に合えば一覧へ含まれる。自分自身を除外する特別処理は入れていないため、監査用の一覧では結果ブックを検索元の外側へ置く。また、走査中のフォルダやファイルをロックする機能もない。別の利用者や同期ソフトが途中で追加・更新・削除すると、開始時点を固定したスナップショットにはならない。重要な照合では更新の少ない時間帯に実行し、StartedAtとFinishedAtを一緒に残す。

ファイル名とパスは文字列のまま保持する

Windowsでは、先頭が「=」「+」「-」「@」の名前や、「00123」のように数字だけで見える名前も作成できる。Excelの標準書式へそのまま代入すると、名前を数式・数値・日付として解釈し、元の文字列と違う表示や値になる場合がある。たとえば拡張子なしの「=1+1」を値として一般書式のセルへ入れると、ファイル名ではなく計算式として扱われ得る。掲載コードは結果を書き始める前にB～E列とK～M列を文字列書式へ固定し、先頭記号と先頭ゼロを含む名前、拡張子、パス、エラー理由を読み取った形のまま保存する。

列	保存形式	理由
B～E	文字列	ファイル名、拡張子、フォルダパス、フルパスの文字を変換しない
F	数値	サイズを並べ替え、合計、KB・MB換算に使えるようにする
G～H	日時	更新日時と作成日時を期間条件や並べ替えに使えるようにする
I	数値	階層の深さを数値として比較できるようにする
K～M	文字列	対象種別、対象パス、理由をExcelの自動変換から守る

すべての列を文字列へすると、サイズや日時の計算・並べ替えが不便になるため、外部から得た文字列列だけを保護する。結果をCSVへ書き出して別のExcelで開く場合は、CSVをダブルクリックすると再び型推測が行われることにも注意する。重要な照合では、Power Queryや「テキストまたはCSVから」で列型を指定して読み込み、元の結果シートと代表的な名前を照合する。

結果を書けないエラーは読み取りエラーとして続行しない

アクセスできないフォルダや、走査中に削除されたファイルは、その対象だけを問題欄へ記録して次へ進める。一方、500件のバッファを結果シートへ書けない、問題欄へ理由を書けない、結果シート自体を作れない、といった出力エラーは処理全体の信頼性を失わせる。ここで個別ファイルのエラーとして続行すると、バッファ件数と実際に書かれた行数がずれ、後続行で配列範囲外や欠落が連鎖する。

掲載コードは、1行分のバッファを組み立てている間と、結果または問題欄へ書き込んでいる間に、それぞれ専用フラグを有効にする。クリティカル区間のエラーはフォルダ・ファイル単位の各ハンドラで握りつぶさず、最上位の処理まで再送出してFAILEDにする。Ctrl+Breakも、読み取りや進捗更新などの安全な地点で受けた場合はCANCELLEDとして完成済みバッファを出力するが、1行の組み立て中やシート書き込み中なら重複・未完成行を避けるためFAILEDにする。結果シートが既にあればB1とB6へ失敗状態と原因を残すが、シート作成前の失敗ではメッセージだけになる。どちらの場合も成功やPARTIALとして扱わず、原因を直して新しい結果シートで最初から再実行する。

最初に変更する3項目

基本の一覧作成で変更するのは、コード先頭の3項目だけでよい。安全上限は、テスト結果と業務要件を確認するまでは初期値のまま使う。

設定	意味	指定例
TARGET_FOLDER	走査を始める子フォルダの絶対パス	C:\Work\検査記録
FILTER_EXTENSION	最後の拡張子を1種類だけ指定。空文字なら全種類	.xlsx、csv、または空文字
UPDATED_WITHIN_DAYS	実行開始時刻から指定日数以内に更新されたファイルだけ出力。0なら全期間	30、7、0

フォルダパスはエクスプローラーからコピーする

手入力では、全角記号、余分な空白、共有名の不足が入りやすい。エクスプローラーで対象フォルダを開き、アドレスバーからパスを取得する。ローカルならドライブ名から、共有なら「\\サーバー名\共有名\子フォルダ」の形で指定する。

コードは相対パス、ワイルドカード、ドライブと共有のルートを拒否する。存在確認の基本はVBAでファイル・フォルダの存在を確認する方法でも確認できる。

拡張子はピリオド付き・なしのどちらでもよい

「.xlsx」と「xlsx」は同じ条件として扱う。大文字と小文字も区別しない。空文字なら拡張子なしを含むすべてのファイルが候補になる。拡張子の取得にはGetExtensionNameを使うため、ピリオドがないファイル名でも開始位置0のエラーにはならない。

更新日条件の基準は実行開始時刻で固定する

30を指定した場合は、マクロの開始時刻から30日前を境界にする。長い走査の途中でNowを何度も計算して境界がずれないよう、開始時に1回だけ基準日時を作る。0は全期間であり、負の値は設定ミスとして開始前に止める。

貼り付けから実行まで

1. 結果を保存するExcelブックのコピーを用意し、マクロ有効ブック形式で保存する。
2. Alt+F11でVisual Basic Editorを開く。
3. 「挿入」から「標準モジュール」を選ぶ。
4. コード全体を貼り付ける。Option Explicitはモジュール先頭に1回だけ置く。
5. 3つの設定値を書き換え、ブックを保存する。
6. 最初はファイル数個・サブフォルダ数個のテスト用フォルダを指定する。
7. Alt+F8からCreateRecursiveFileListを選び、実行する。
8. 確認ダイアログのパスを目で確認してからOKを押す。

毎回の実行が安定し、結果とスキップ欄の確認方法が決まった後なら、ボタンへ割り当てられる。手順はマクロをボタンから実行する方法を参照する。範囲が変わる業務では、ボタン化しても確認ダイアログを削らない。

結果シートのStatusを最初に確認する

実行後はファイル行より先にB1セルのStatusを見る。件数が多く見えても、PARTIALやSTOPPED_LIMITなら完全な一覧ではない。K～M列には、辿らなかったリンク、隠し・システムフォルダ、アクセスエラー、長いパスなどを記録する。

Status	意味	次の確認
COMPLETE	設定した境界内で、エラーやスキップを記録せずキューを処理し終えた	件数と代表パスを元フォルダで照合する
PARTIAL	全体停止せずキュー処理を終えたが、未走査・未出力・長いパスの短縮などの問題を1件以上記録した	K～M列の理由と対象パスを確認する
STOPPED_LIMIT	フォルダ数、走査ファイル数、出力ファイル数、Excel行数、時間のいずれかの上限で全体を停止した	B6の停止理由を確認し、対象を分割する
CANCELLED	読み取りや進捗更新などの安全な地点でCtrl+Breakを受けた	途中結果として扱う。行組み立て中・書き込み中の中断は整合性保護のためFAILEDになる
FAILED	出力シート作成や書き込みなど、処理全体を続行できないエラーが起きた	結果シートがあればB6、なければエラーメッセージの番号と説明を保存して原因を調べる

COMPLETEは「コードが把握できた範囲で問題を記録しなかった」という意味であり、ファイルシステムの時点スナップショットや監査証明ではない。走査中に別の利用者がファイルを追加・削除・更新すれば、結果は開始時点とも終了時点とも完全には一致しない。

出力列とスキップ欄の読み方

列	内容	利用例
A	出力順の番号	行の識別
B	ファイル名	同名ファイルの抽出
C	最後の拡張子	形式別のフィルタ
D	親フォルダのパス	格納場所別の集計
E	フルパス	対象ファイルの特定
F	サイズ（Bytes）の数値	並べ替え、合計、容量確認
G	最終更新日時	更新の新旧を確認
H	作成日時	作成時期の参考
I	開始フォルダを0とした階層	深い配置の発見
K～M	対象種別、対象パス、スキップ・エラー理由	取得漏れの調査

サイズ列は「45KB」のような文字列ではなく、バイト数の数値を保存する。表示形式だけ桁区切りにするため、数値として並べ替えや合計ができる。必要なら別列で1024除算し、KBやMB表示を作る。

全階層を辿る仕組み：再帰呼び出しではなく明示スタック

一般に「再帰検索」と呼ばれる処理は、あるフォルダからサブフォルダへ降り、さらにその下へ進む。この実装方法は、自分自身を呼ぶ再帰プロシージャだけではない。安全版はCollectionを未処理フォルダのスタックとして使う。

1. 開始フォルダと階層0をCollectionへ追加する。
2. 末尾の1件を取り出し、そのフォルダ直下のFilesを調べる。
3. SubFoldersを確認し、安全条件を満たす子フォルダだけをCollectionへ追加する。
4. Collectionが空になるか、安全上限・中止条件に達するまで繰り返す。

この方式なら、フォルダが深くなってもVBAの呼び出しスタックを階層ごとに消費しない。さらに、未処理フォルダ数を上限管理できる。並び順はファイルシステムとCollectionへの追加順に依存するため、業務で順番が必要なら出力後にExcelで明示的に並べ替える。

FilesとSubFoldersは直下だけを返す

Folder.Filesは、そのFolder直下のFileオブジェクトの集合を返す。Folder.SubFoldersも直下のFolderオブジェクトの集合である。1回の取得で全階層が返るわけではないため、未処理の子フォルダを順に取り出す必要がある。

Microsoft公式資料では、FilesとSubFoldersには隠し属性・システム属性の項目も含まれる。安全版は既定でそれらを除外し、隠し・システムフォルダはスキップ欄へ残す。

On Error Resume Nextで子ツリー全体を包まない

アクセス拒否を避けるために、サブフォルダ呼び出し全体をOn Error Resume Nextで囲むと、行上限、長いパス、スタック不足、出力エラーなども同じように見えなくなる。VBAの仕様では、呼び出し先で処理されないエラーが呼び出し元へ戻り、呼び出しの次の行から継続する場合がある。その結果、枝の残りを欠落させたまま「完了」と表示し得る。

掲載コードは、フォルダ列挙、ファイル列挙、個別ファイル、個別サブフォルダでエラー範囲を分ける。番号と説明を保存し、続行できる読み取りエラーだけをK～M列へ記録する。出力シート作成やバッファ書き込みのような全体エラーはFAILEDにする。

フィルタと除外条件の考え方

全拡張子を出す場合

FILTER_EXTENSIONを空文字にする。GetExtensionNameは拡張子がないファイルに空文字を返すため、ファイル名のピリオド位置をMidで直接切り出す必要はない。複数拡張子が必要なら、まず全拡張子で小さくテストし、出力後のオートフィルターで確認する方法が安全である。

更新日を絞る場合

UPDATED_WITHIN_DAYSを30にすると、開始時刻から30日前以降の最終更新日時を持つファイルだけを出力する。DateLastModifiedはファイルシステムの属性であり、「内容を人が確認した日」や「業務上の有効日」とは限らない。更新日だけを根拠に削除や移動を自動化しない。

隠し・システム項目を含める場合

INCLUDE_HIDDEN_SYSTEMをTrueにすれば、隠し・システム属性の通常項目も候補にする。ただし、再解析ポイントは引き続きスキップする。システム領域を含める前に、なぜ必要か、アクセス権限があるか、結果をどこまで利用するかを決める。

再解析ポイントを辿りたい場合

単に属性1024の除外を消すだけでは安全にならない。リンク先の実体識別、訪問済みID、ボリューム境界、クラウドのオンライン専用状態などを管理する必要がある。この記事の初心者向けコードでは対象外とし、実体側の明確な子フォルダを別実行で指定する。

本番前のテスト項目

テスト用の開始フォルダを作り、直下とサブフォルダへ数個のファイルを置く。拡張子あり、拡張子なし、古い更新日、隠し属性など、実際の業務で出会う種類を小さく再現する。いきなり共有サーバー全体を対象にしない。

テスト	準備	期待結果
通常の2階層	親・子フォルダへ各2ファイルを置く	StatusがCOMPLETEで、4件と各階層が出る
空フォルダ	ファイルのないフォルダを指定する	COMPLETE、出力0件。既存シートは変化しない
拡張子なし	「README」のようなファイルを置き、拡張子条件を空にする	停止せず、拡張子列が空で出力される
拡張子フィルタ	xlsx、csv、txtを混在させる	指定した最後の拡張子だけが出力され、ほかはfiltered_filesへ数えられる
更新日フィルタ	更新日時の異なるテストファイルを用意する	開始時刻を基準に条件内だけが出力される
同じ秒の連続実行	続けて実行する	既存結果を消さず、末尾に連番を付けた新しいシートができる
存在しないパス	テスト用に誤ったパスを指定する	新規シート作成前にFAILEDのメッセージで停止する
ルート指定	テスト時だけドライブ直下を指定する	走査開始前に拒否する
件数上限	安全上限をテスト件数より小さくする	STOPPED_LIMITとなり、B6に停止理由が出る
利用者中止	少し大きいテストで進捗表示中にCtrl+Breakを押す	安全な地点ならCANCELLEDとなり、Excelのイベントと画面状態が復元される

アクセス拒否や再解析ポイントのテストは、権限設定を勝手に変えず、既に管理者が用意したテスト領域で行う。業務サーバーの権限をテスト目的で変更すると、ほかの利用者へ影響する。

件数照合は補助確認として行う

結果の走査ファイル数、出力ファイル数、フィルタ件数、問題件数を確認する。さらに、代表的な深いフォルダをエクスプローラーで開き、該当ファイルが一覧にあるかを照合する。フォルダのプロパティに表示される件数との比較も参考にはなるが、権限、リンク、隠し項目、処理中の増減で差が出るため、完全性の単独証明にはならない。

新しい結果が正常になるまで以前の結果を残す

安全版は毎回新しいシートを作るため、前回の結果を自動消去しない。新しいStatus、件数、問題欄を確認してから、不要な古い結果シートを人が整理する。ブックを保存せず閉じれば今回の追加シートも残らないので、保存の判断も利用者ができる。

トラブルシューティング

表示・症状	主な原因	安全な対応
対象フォルダが見つからない	入力ミス、外付けドライブ未接続、共有名変更、ネットワーク切断	エクスプローラーで実際に開ける絶対パスを再取得する
絶対パスを求められる	相対パス、ドライブ相対表記、不完全なUNCパス	ドライブ名またはサーバー名・共有名から指定する
ルートを指定できない	対象範囲が広すぎる	用途が明確な子フォルダへ絞る。安全判定を削除しない
対象自体が再解析ポイント	ジャンクション、シンボリックリンク、クラウド同期ルート	実体側の子フォルダを指定するか、対象を管理者へ確認する
PARTIALになる	アクセス拒否、リンク、隠し・システムフォルダ、個別ファイル属性取得失敗	K～M列を確認し、必要な対象が欠けていないか判断する
STOPPED_LIMITになる	範囲が広い、上限が小さい、ネットワークが遅い	まず開始フォルダを業務単位に分割する。上限を無条件に増やさない
FAILEDでシート追加に失敗	ブック構造の保護、読み取り専用ブック、シート数やメモリ、イベント処理	コピーした編集可能なマクロ有効ブックで再確認する
出力が0件	空フォルダ、拡張子条件、更新日条件、隠し属性の除外	Countsと設定を確認し、小さい既知ファイルで条件を1つずつ外す
同名ファイルが複数ある	別フォルダに同じファイル名が存在	ファイル名だけで判断せず、フォルダパス・フルパスも使う
結果の順番が毎回違う	FilesとSubFoldersの列挙順に業務上の保証がない	出力後にフルパスや更新日時で明示的に並べ替える
走査中にファイルが増減した	共有利用者、同期アプリ、別処理の更新	更新が少ない時間帯に再実行し、実行日時と対象範囲を記録する

ステータスバーが戻らない場合

通常のエラーとCtrl+BreakはCleanExitを通り、実行前のStatusBar、ScreenUpdating、EnableEvents、EnableCancelKeyを復元する。VBEの「リセット」やExcelプロセスの強制終了は通常の後処理を通らないため、別マクロの実行中に設定が残ることがある。強制終了を常用せず、まずCtrl+Breakで中止する。

進捗表示の一般的な作り方はステータスバーへ進捗を表示する方法でも確認できる。DoEventsはExcelへ制御を返す補助であり、検索を高速化したり、循環を自動解決したりする命令ではない。

大量ファイルで遅いときの判断順

処理が遅いときは、コードの高速化より先に対象範囲を見直す。ドライブ全体を1回で走査する設計は、必要な業務データと無関係なフォルダまで含み、権限エラーも増やす。

1. 開始フォルダを年度、部門、案件などの業務単位へ分ける。
2. 必要な拡張子だけへ絞る。
3. 必要なら更新日条件を設定する。
4. ローカルとネットワークで小さい同等サンプルを測る。
5. Statusと問題欄を確認し、欠落がない範囲で上限を調整する。
6. Excelへ収まらない規模なら、CSV、データベース、PowerShellなど別の出力先を検討する。

500件ずつ書く理由

各ファイルについて9個のセルへ個別に書くと、Excelオブジェクトとの往復が増える。掲載コードは500行分を配列にため、範囲へまとめて書く。500は結果精度を変える値ではなく、メモリ使用と書き込み回数の折衷となる初期値である。

Excelの行数上限より小さい停止値を持つ

現在の一般的な.xlsx形式では、1シートは1,048,576行である。ヘッダーや実行情報も使うため、データへ使える行はそれより少ない。コードはRows.Countも確認するが、初期の出力上限を100,000件にし、想定外の巨大走査を早く見つける。

100,000件を超える一覧が日常的に必要なら、上限を増やすだけではなく、ブックサイズ、保存時間、フィルター操作、再実行、監査保管まで含めて設計する。複数シートへ分割すると1回の一覧を跨いで確認する必要があり、CSVならセル書式や数式がない。用途に合う保存先を選ぶ。

ネットワーク共有は速度以外も確認する

UNCパスは指定できるが、接続切断、資格情報、共有権限、ファイルサーバー負荷が結果へ影響する。マクロ実行者がエクスプローラーで対象の子フォルダを開けても、その下のすべてへアクセスできるとは限らない。PARTIALの対象パスを保存し、管理者へ確認する。

OneDriveなどの同期領域

オンライン専用ファイルやプレースホルダーは、属性取得時に同期やダウンロードが発生したり、サイズの意味がローカル実体と異なったりする場合がある。安全版は再解析ポイントを除外するため、同期領域を完全列挙する用途には向かない。クラウド側の管理・検索・エクスポート機能も検討する。

一覧の完全性について明示しておくこと

このマクロは、開始から終了までフォルダを順番に読む。データベースのスナップショットのように、全フォルダを同じ瞬間の状態へ固定しない。走査中の追加は列挙タイミングによって入ることも入らないこともあり、削除や名前変更はエラーまたは欠落になる可能性がある。

監査や証跡に利用する場合は、次をセットで保存する。

• 結果ブックまたは結果シートの保存版
• Status、開始・終了日時、対象パス
• 走査・出力・フィルタ・問題件数
• K～M列のスキップ・エラー一覧
• 使用した設定値とコード版
• 対象フォルダを更新しない時間帯の運用記録

「COMPLETEだから全ストレージを証明した」とは説明せず、「指定した境界と権限の範囲で、記録された問題なしに走査を終えた」と説明する。重要な提出物では、管理者側のファイルサーバーログや正式な棚卸し機能とも照合する。

一覧を次の処理へ使うときの順番

出力結果は、重複候補の確認、更新が止まったファイルの調査、格納場所の集計などに使える。ただし、一覧から直ちにコピー・移動・削除へ進めると、PARTIALで欠けた項目や同名ファイルを誤って扱う可能性がある。

1. StatusがCOMPLETEか、PARTIALの理由を許容できるか確認する。
2. フルパスをキーにし、ファイル名だけで対象を特定しない。
3. 条件に合う候補を別列で印付けする。
4. 最初は読み取り専用のプレビューを作る。
5. 数件のテストデータでコピー先・上書き条件を確認する。
6. 移動や削除はバックアップと明示承認を別に設計する。

ファイル操作へ進む場合はVBAでファイルをコピー・移動する方法を参照できる。複数ブックの内容を集約する目的なら、一覧作成後に複数Excelファイルを1つに統合する方法へ進む。どちらも、元の一覧が完全かを先に確認する。

よくある危険な書き方をどう変えたか

危険・不正確な書き方	起こり得ること	安全版の変更
固定名の結果シートへCells.Clear	既存の値、数式、書式を確認なしに消去する	毎回一意な新規シートを追加し、以前の結果を保持する
再帰呼び出し全体をOn Error Resume Nextで囲む	権限以外の不具合も消え、枝の途中から取得漏れになる	処理単位ごとにエラーを捕捉し、対象パスと理由を記録する
再帰プロシージャで無制限に自分自身を呼ぶ	深い階層やリンクでスタック不足・重複走査になる	Collectionを明示スタックにし、再解析ポイントと深さを制限する
Midとピリオド位置で拡張子を切り出す	拡張子なしファイルで開始位置0のエラーになる	GetExtensionNameを使い、拡張子なしを空文字として扱う
出力行を無制限に増やす	Excel行上限で途中停止し、そのエラーも隠れる	独自上限とRows.Countの両方を確認し、STOPPED_LIMITにする
エラー後も「完了」または「0件」と表示	利用者が欠落に気づかない	COMPLETE、PARTIAL、STOPPED_LIMIT、CANCELLED、FAILEDを分ける
ScreenUpdatingを常にTrueへ戻す	実行前に別処理が設定した状態を壊す	実行前の画面、イベント、中止、ステータスバー設定を保存して復元する

「エラーを無視すれば止まらない」と「正しい一覧を作れる」は別である。読み取り処理でも、結果ブックの消去、黙った欠落、誤った完了表示は業務上の事故になる。安全版は、続行できる読み取りエラーを見える形で残し、出力処理自体の失敗は止める。

設定例を目的別に整理する

設定を一度に何か所も変えると、0件の原因が分かりにくい。最初は全期間・全拡張子で数個のテストファイルを確認し、その後に条件を1つずつ追加する。

目的	拡張子設定	更新日数	確認点
対象範囲の全通常ファイルを確認	空文字	0	拡張子なしも含む。隠し・システムと再解析ポイントは既定で除外
Excelブックだけを確認	.xlsx	0	xlsm、xls、csvは別拡張子なので含まれない
最近7日間のCSVを確認	csv	7	実行開始時刻を基準に最終更新日時を比較する
最近30日間のマクロ有効ブックを確認	.xlsm	30	ファイルを開かず属性だけを取得する

「Excelファイルすべて」という条件には、xlsx、xlsm、xls、xlsbなど複数の拡張子があり得る。1種類の条件で目的を満たさない場合は、全種類を出してExcelで絞るか、業務で許可する拡張子を明文化してから許可リストへ拡張する。

Countsの数字から状況を読む

B5セルには、走査フォルダ、走査ファイル、出力ファイル、フィルタ除外ファイル、問題件数を残す。数字の関係を見ると、0件やPARTIALの原因を絞りやすい。

例	読み方	次の確認
走査100、出力100、フィルタ0、問題0	設定した条件では全走査ファイルを出力した	代表パスと元フォルダの件数を照合する
走査100、出力20、フィルタ80、問題0	拡張子・更新日・属性条件で80件を除外した	フィルタ設定が意図どおりか確認する
走査100、出力95、問題5	個別ファイルまたはフォルダで取得できない項目があった	K～M列の5件を調べる
走査0、出力0、問題0	開始フォルダが空、または子フォルダだけで通常ファイルがない可能性	フォルダ数と対象パスを確認する
走査数が上限と同じ	STOPPED_LIMITで残りが未走査の可能性	StatusとB6を優先し、数字だけを完了件数と見なさない

これらは説明用の数値例であり、性能や実際のフォルダ構成を示すものではない。重要なのは、出力件数だけを見ず、走査・フィルタ・問題・停止理由をセットで読むことである。

出力ブックのイベントを一時停止する理由

結果シートへ数千行を書き込むと、WorkbookやWorksheetの変更イベントが設定されているブックでは、行ごと・範囲ごとに別のマクロが動く可能性がある。予期しない計算、メッセージ、外部連携を避けるため、安全版は出力開始前にEnableEventsをFalseへする。

単に最後にTrueへ設定すると、実行前から別処理の都合でFalseだった状態を変更してしまう。そこで実行前の値を保存し、正常・一部取得・中止・失敗のどの経路でも元の値へ戻す。同じ考え方でScreenUpdating、EnableCancelKey、StatusBarも復元する。

イベントを止めても、シートの追加と結果書き込み自体は行われる。検索元は読み取り専用だが、実行ブックまで読み取り専用ではない。この違いを利用者へ説明し、重要ブックのコピーで試す。

定期運用する場合の記録

タイミング	確認事項	残す記録
実行前	対象パス、拡張子、日数、ネットワーク状態、更新作業の有無	実行予定と設定値
実行直後	Status、Counts、B6、K～M列	結果シート名、開始・終了日時
内容確認	代表的な直下・深いフォルダ、同名ファイル、フィルタ境界	照合したパスと結果
構成変更時	共有名、権限、同期方式、フォルダ階層、ファイル形式	変更理由と再テスト結果
結果整理時	新しい結果が利用可能か、古い結果の保管要否	削除した結果シートと判断者

無人実行へ進める場合は、Excelが起動できなかった、共有へ接続できなかった、マクロが停止した、といった「結果シート自体が作られない失敗」を別に監視する必要がある。結果がないことと、対象ファイルが0件だったことは同じではない。

VBA以外へ切り替える目安

FSOとExcelは、担当者が結果を目視し、フィルタや集計へつなげる中規模の一覧に向く。次の条件が常態化したら、コードの上限を増やし続けるより別の仕組みを検討する。

• 毎回Excelの出力上限に近づく。
• 複数サーバーや複数資格情報を跨ぐ。
• リンク先を含む実体重複排除が必要である。
• 秒単位の差分や監査証跡を継続保存する。
• 利用者がブックを開かなくても定期実行・通知したい。
• 複数人が同じ一覧を検索・共有する。

一度だけのパス一覧ならdirやPowerShell、再利用可能な変換ならPower Query、継続的な大量管理ならデータベースやサーバー側インベントリが候補になる。どの手段でも、アクセスできなかった対象と実行時刻を記録する考え方は変わらない。

FSOのオブジェクトを役割で理解する

要素	安全版での役割	行わないこと
FileSystemObject	フォルダ取得、拡張子取得、絶対パス化	コピー、移動、削除、保存先作成には使わない
Folder	パス、属性、直下のFilesとSubFoldersを読む	名前変更、移動、削除をしない
File	名前、パス、サイズ、作成・更新日時、属性を読む	開く、内容変更、コピー、削除をしない
Collection	これから調べるフォルダパスと階層を保持する	ファイルシステム自体を変更しない
Worksheet	結果と問題一覧を新規シートへ書く	既存シートをClearしない

FSOにはCopyFile、MoveFile、DeleteFile、DeleteFolderなどの変更メソッドもあるが、一覧取得では呼び出さない。オブジェクトを作っただけでファイルが変わるわけではなく、どのメソッドとプロパティを使うかで処理の性質が決まる。

エラーを「続行可能」と「全体停止」に分ける

すべてのエラーで停止すると、1個のアクセス拒否でほかの正常フォルダも調べられない。反対にすべてを無視すると、出力失敗まで隠れてしまう。掲載コードは、対象単位で記録して続けられるものと、一覧の信頼性を保てないため全体停止するものを分ける。

分類	例	結果
対象単位で続行	個別フォルダのアクセス拒否、個別ファイルの属性取得失敗	問題欄へ記録し、StatusをPARTIALにする
規則による除外	再解析ポイント、隠し・システムフォルダ、深さ超過	対象パスと理由を残し、完全取得とは扱わない
安全上限で停止	件数、時間、出力行の上限	STOPPED_LIMITにし、未処理が残ることを示す
利用者による停止	読み取り・進捗更新中のCtrl+Break	安全な地点ならCANCELLED、行組み立て・書き込み中ならFAILEDにし、設定を復元する
全体停止	結果シートを作れない、バッファをシートへ書けない、設定が不正	FAILEDとして終了し、成功メッセージを出さない

同じエラー番号でも、対象パスや発生箇所で意味が変わる。問題欄の番号だけを見て一括除外せず、対象種別、パス、説明をセットで確認する。

長いパスと表示上の注意

Windowsやアプリケーションが扱えるパス長は、OS設定、API、ネットワーク、アプリの対応状況で異なる。FSOがFileオブジェクトを返せても、Excelセルには1セルあたりの文字数上限がある。掲載コードはフルパスがセル上限を超えた場合、末尾へtruncatedと付けて短縮し、その事実を問題欄へ残す。

短縮されたフルパスは、ファイル操作の入力としてそのまま使えない。元の完全パスが必要な規模では、Excelセルを出力先に選ぶ設計自体を見直し、CSVやデータベースなどへ保存する。

また、同じファイルへ短い8.3形式、割り当てドライブ、UNCなど複数の表記で到達できる場合がある。安全版は開始した1本のツリーを走査し、再解析ポイントを除外するが、異なる実体表記を統合する完全な重複排除はしない。

出力後の並べ替えをコードへ固定しない理由

ファイル名順、フォルダ順、更新日順、サイズ順のどれが正しいかは利用目的で変わる。コード内で一律に並べ替えると、処理時間が増え、元の走査順も失われる。安全版はヘッダーへオートフィルターを設定し、利用者が目的に合わせて並べ替える。

監査用に順番を固定する場合は、並べ替えキーと昇順・降順を運用手順へ記載する。ファイル名だけでは別フォルダの同名ファイルが隣接するため、通常はフォルダパスまたはフルパスを第1キーにする。

公開・配布前のコード確認

自分のPCで動いた後にほかの担当者へ渡す場合は、コードだけでなく前提条件も引き継ぐ。

• Windows版Excelであること。
• 参照設定不要のCreateObject方式であること。
• 結果はThisWorkbookへ追加されるため、コードを入れたブックが出力先になること。
• マクロ実行権限とブック構造の編集権限が必要なこと。
• 検索元の子フォルダを閲覧できる範囲だけが結果になること。
• 再解析ポイントと隠し・システム項目を既定で除外すること。
• 安全上限へ達した結果は完全一覧ではないこと。
• 組織のマクロ署名、信頼済み場所、情報持ち出しルールへ従うこと。

設定値をコードへ直接書く方式は分かりやすい一方、担当者が誤編集する可能性がある。定期配布するなら、設定専用シート、入力検証、保護、版番号、変更履歴を追加し、コード本文を編集しなくても対象を選べる仕組みを検討する。

業務利用へ移すための受け入れ判定

テストが1回成功しただけで本番運用にしない。次の項目を担当者が説明でき、実際の結果で確認できた場合に限って対象範囲を本番へ切り替える。

• 開始フォルダが業務上必要な子フォルダで、ルートやリンクではない。
• 直下・複数階層・空フォルダ・拡張子なしのテスト結果が期待と一致した。
• 拡張子条件と更新日条件の境界ファイルを確認した。
• 以前の結果シートやほかのシートが消去・変更されていない。
• PARTIAL、STOPPED_LIMIT、CANCELLEDをCOMPLETEと区別できる。
• K～M列の対象パスから、取得できなかった場所を特定できる。
• Ctrl+Break後に画面更新、イベント、ステータスバーが元へ戻る。
• 結果ブックを保存する場所と閲覧権限が決まっている。
• 結果から移動・削除を自動実行しない運用になっている。
• 構成や権限が変わったときに再テストする担当者が決まっている。

本番初回は、フォルダ更新が少なく、担当者が結果をすぐ確認できる時間に実行する。問題欄が0件でも代表的な深いパスを照合し、結果と設定値を保存する。以後も、共有名、権限、同期方式、ファイル形式、上限値のいずれかが変わったら、過去の成功を根拠にせず受け入れ判定をやり直す。

安全上限を変更する前の判断

初期値でSTOPPED_LIMITになった場合、最初の選択肢は上限拡大ではなく対象分割である。開始フォルダを年度や部門ごとに分ければ、障害箇所の特定、再実行、結果の保存が容易になる。

上限	守るもの	変更前に確認すること
MAX_FOLDERS_TO_SCAN	誤った広域指定と巨大な未処理キュー	必要な業務フォルダ数、リンク除外、再実行単位
MAX_FILES_TO_SCAN	フィルタ外を含む無制限列挙	全ファイル概数、ネットワーク負荷、実行可能時間
MAX_FILES_TO_OUTPUT	結果ブックの巨大化とExcel行上限	必要列、ファイル形式、CSVやデータベースへの切替
MAX_DEPTH	想定外の深い配置	通常の最大階層と、深い場所がリンクでないこと
MAX_RUNTIME_SECONDS	無人での長時間占有	手動テスト時間、ネットワーク変動、失敗時の監視

上限を変えたら、コード版と設定値を運用記録へ残す。昨日のCOMPLETEと今日のCOMPLETEでも、対象や上限が違えば同じ範囲を確認した結果ではない。

FSO再帰検索のよくある質問

Q1. なぜ再帰Subを使わないのですか？

深い階層ごとに呼び出しスタックを消費し、リンクを辿ると循環する可能性があるためだ。掲載コードはCollectionに未処理フォルダを保持し、反復処理で全階層を走査する。検索目的は同じだが、深さ・件数・中止を管理しやすい。

Q2. 隠しファイルやシステムファイルは含まれますか？

FSOのFilesとSubFolders自体は隠し・システム属性も列挙する。掲載コードは既定でそれらを除外する。通常ファイルの除外はfiltered_filesへ数え、フォルダの除外はスキップ欄へ記録する。

Q3. 複数の拡張子を同時に指定できますか？

完成コードの設定は1種類だけである。最初は空文字で全種類を小さく出力し、Excelのフィルターで必要な拡張子を確認する。複数条件へ改造する場合も、GetExtensionNameの戻り値を許可リストと比較し、ファイル名の末尾文字列だけで判定しない。

Q4. ネットワーク共有でも使えますか？

子フォルダのUNCパスは指定できる。ただし共有ルートは拒否する。接続、資格情報、下位フォルダの権限、サーバー負荷によってPARTIALや時間上限になる可能性があるため、対象を分割して試す。

Q5. OneDriveフォルダを完全に一覧化できますか？

このコードでは保証しない。再解析ポイントを安全のため除外するので、同期ルートやオンライン専用項目が未走査・未出力になる場合がある。K～M列を確認し、必要ならクラウド側の管理機能を使う。

Q6. PARTIALでも出力結果を使ってよいですか？

用途と問題・スキップ理由による。特定の不要なリンクだけが除外されたと確認できる場合と、重要な業務フォルダがアクセス拒否になった場合では意味が違う。問題欄を確認せず、完全一覧として提出しない。

Q7. 100,000件を超えるファイルを出したい場合は？

まず開始フォルダを分割する。1シートの上限だけでなく、ブック容量、保存時間、再実行、確認作業も増える。大量一覧を継続利用するなら、CSV、Power Query、PowerShell、データベースなども比較する。

Q8. 以前の結果シートは自動削除されますか？

削除されない。毎回新しい一意なシートを作る。新しいStatusと件数を確認した後、不要な結果だけを人が整理する。自動削除や固定名シートの全消去は含めていない。

Q9. ファイルを開いて内容も確認しますか？

開かない。FSOから名前、パス、サイズ、作成・更新日時、属性を取得する。ブックのシート名、セル内容、CSVの行数など、ファイル内部を調べる処理は別に設計する。

Q10. Mac版Excelでも動きますか？

このままでは動かない。WindowsのFileSystemObject、絶対パス、再解析ポイント属性を前提にしている。Macではパスとファイルシステム操作をその環境向けに作り直す必要がある。

Microsoft公式資料で確認した仕様

• FileSystemObject object：ファイルシステムへアクセスするオブジェクトとGetExtensionNameなどのメソッド
• Folder object：Files、SubFolders、Attributes、Pathなどのプロパティ
• On Error statement：呼び出し先エラーとResume Nextの動作
• Range.Clear method：値・数式・書式を含む範囲消去。安全版では既存結果へ使用しない
• Range.Value property：2次元配列を範囲へまとめて書き込む方法
• Application.EnableCancelKey property：利用者による中止をエラーハンドラへ渡す設定
• DoEvents function：OSへ制御を返す動作
• File Attribute Constants：再解析ポイント属性1024などのWindows属性
• Excel specifications and limits：1シート1,048,576行などの制限
• dir command：/s、/b、/a属性指定の公式構文

安全に一覧化するための最終確認

• Windows版デスクトップExcelと、コピーしたマクロ有効ブックを使う。
• ドライブや共有のルートではなく、用途が明確な子フォルダを指定する。
• 最初は小さなテストフォルダで、通常・空・拡張子なし・中止・上限を確認する。
• 既存シートを消さず、毎回新しい結果シートへ出力する。
• 再解析ポイント、隠し・システム項目、アクセスエラーを問題欄で確認する。
• COMPLETE以外を完全な一覧として提出しない。
• COMPLETEでも走査中の更新を固定したスナップショットではないと理解する。
• 結果から移動・削除へ進む前に、フルパスと対象候補を人が確認する。

この順序を守れば、FSOによる全階層走査を「止まらないコード」ではなく、「どこまで取得し、何を取得できなかったか説明できる一覧作成」として運用できる。