VBA技術解説
Dirは限界！FSOは遅い！VBAファイル検索をWindows APIで爆速化

ExcelマクロVBAの問題点と解決策、VBAの技術的解説
公開日：2025-10-22　最終更新日：2025-10-26

Dirは限界！FSOは遅い！VBAファイル検索をWindows APIで爆速化


VBAでフォルダ内のファイル一覧を取得するとき、Dir 関数や FSO (FileSystemObject) を使っているのではないでしょうか？
Dir 関数は文字数・文字コードなどに制限が多く、FSOは処理が遅くファイル数が多いと多大な時間がかかるという致命的な問題があります。


本記事では、これらの悩みを一気に解決するWindows API (FindFirstFileW など) を活用した爆速ファイル検索VBAを紹介します。
大量のファイルでも爆速で取得できるVBAをご紹介します。

FSOは遅い！WindowsAPIでファイル一覧を爆速取得！

ページ内目次

Dir関数とFSOの課題
ファイル一覧取得_Dir関数版
ファイル一覧取得：FSO(FileSystemObject) 版
ファイル一覧取得：Windows API (FindFirstFileW, FindNextFileW) 版
クラスモジュール
標準モジュール
拡張用のファイル存在確認とファイル情報取得のサンプルVBA
ファイルサイズが2GBを超える場合の対応方法
処理時間比較：Dir vs FSO vs API


Dir関数とFSOの課題

VBAでファイル一覧を取得する際によく使われる Dir 関数と FSO(FileSystemObject) には、それぞれ以下のような制限と課題があります。

Dir関数の制限事項
  • 256バイトを超えるパス名が扱えない
    従来のVBA関数は、OSのMAX_PATH制限（通常256文字）の影響を受け、パスが非常に長いファイルが存在すると、検索から漏れるか、エラーで処理が中断してしまいます。
  • UNICODEファイル名が扱えない
    Dir 関数は設計が古いため、日本語、多言語、特殊文字などの UNICODEファイル名を正しく処理できず、文字化けや検索漏れの原因となり、データの信頼性を損ないます。
  • 特殊なネットワークドライブでエラー
    ネットワークドライブの「\\abc.def.ghi\」このような名称の場合はエラーになります。
    「実行時エラー '52':
    ファイル名または番号が不正です。」
  • 再帰的に呼び出す事ができない
    Dir 関数は、シングルトン（シングルインスタンスオブジェクト）です。
    つまり、一つの Dir 検索が実行中に、別のフォルダに対して Dir を呼び出すと、進行中の検索の状態が上書きされてしまい、結果として正確な再帰処理（深さ優先検索）を記述することが極めて困難になります。

FSO (FileSystemObject) の課題

  • 処理速度が遅い
    FSOは、VBAとWindowsの間のCOMレイヤーを介して動作するため、特に大量のファイルや深い階層を扱う場合にオーバーヘッドが発生し、処理速度が Dir関数やAPIに比べて遅くなる傾向があります。
  • ネットワークドライブで極端に遅くなる
    ネットワークドライブ上のファイル検索では、COMのオーバーヘッドに加えてネットワーク遅延の影響が重なるため、処理速度が極端に低下します。

これらの課題を解決するための手段として、Windows API (FindFirstFileW など) を利用します。


ファイル一覧取得_Dir関数版

標準モジュール
Option Explicit

' ==========================================================
' プロシージャ名: ファイル一覧取得_Dir関数版（サブフォルダ対応）
' 目的: 指定されたフォルダ配下のファイルおよびフォルダの一覧をDir関数で取得し、Excelシートに出力する。
' 処理概要:
' 1. Dir関数による非再帰探索で全フォルダパスを取得する。
' 2. FileLen/FileDateTime関数を使用してファイルの詳細情報を取得し、Collectionに格納する。
' 3. 検索中は、画面更新停止や計算手動化によりExcelの動作を最適化する。
' 4. 取得した全件の結果データを配列で整形した後、シートに一括で書き出し高速化する。
' ==========================================================
Sub ファイル一覧取得_Dir関数版()
　　
　　Dim rootDir As String　　　　　　　　　　　　　　　 ' 検索対象のルートフォルダパス (A1セルから取得)
　　Dim ws As Worksheet　　　　　　　　　　　　　　　　 ' 結果を出力するワークシート
　　Dim outputList As Collection　　　　　　　　　　　　' GetFileListから受け取った検索結果Collection
　　Dim outputData() As Variant　　　　　　　　　　　　 ' 最終的にシートに書き出すための整形済み2次元配列
　　Dim totalCount As Long
　　Dim i As Long
　　Dim startTime As Double
　　Dim calcMode As Long
　　
　　' 定数設定（検索設定と出力設定）
　　Const INCLUDE_FOLDERS As Boolean = True　　　　　　 ' 結果にフォルダ（ディレクトリ）を含めるか
　　Const INCLUDE_FILES As Boolean = True　　　　　　　 ' 結果にファイルを含めるか
　　Const HEADER_ROW As Long = 3　　　　　　　　　　　　' ヘッダー（見出し）を出力する行番号
　　Const RESULT_START_ROW As Long = 4　　　　　　　　　' 検索結果のデータを出力開始する行番号
　　
　　On Error GoTo ErrorHandler
　　
　　Set ws = ActiveSheet
　　
　　' パスの取得と検証
　　rootDir = Trim(CStr(ws.Cells(1, 1).Value))
　　If rootDir = "" Then
　　　　MsgBox "フォルダパスが指定されていません。", vbExclamation, "エラー"
　　　　Exit Sub
　　End If
　　If Dir(rootDir, vbDirectory) = "" Then
　　　　MsgBox "指定のフォルダは存在しません:" & vbCrLf & rootDir, vbExclamation, "エラー"
　　　　Exit Sub
　　End If
　　
　　' 末尾にバックスラッシュを追加（GetFileList内部でも行っているが保険として）
　　rootDir = AddTrailingBackslash(rootDir)
　　
　　startTime = Timer
　　Call StartOptimization(calcMode)　　　　　　　　　　' 自動計算と画面更新を停止
　　
　　' ヘッダー行の設定
　　With ws.Cells(HEADER_ROW, 1).Resize(, 5)
　　　　.Value = Array("フォルダパス", "名前", "種類", "サイズ", "更新日時")
　　　　.Font.Bold = True
　　　　.Interior.Color = RGB(200, 200, 200)
　　　　.HorizontalAlignment = xlCenter
　　End With
　　
　　' Dir関数検索の実行（詳細情報も取得）
　　Set outputList = GetFileListWithDetails(rootDir, INCLUDE_FOLDERS, INCLUDE_FILES)
　　
　　totalCount = outputList.Count
　　
　　' 過去のデータをクリア
　　ws.Range(ws.Cells(RESULT_START_ROW, 1), ws.Cells(ws.Rows.Count, 5)).ClearContents
　　
　　' 結果が0件の場合の処理
　　If totalCount = 0 Then
　　　　Call EndOptimization(calcMode)
　　　　MsgBox "対象となるファイル/フォルダが見つかりませんでした。", vbInformation, "結果"
　　　　Set outputList = Nothing
　　　　Exit Sub
　　End If
　　
　　' 出力用配列の準備（[0]フォルダパス, [1]名前, [2]種類, [3]サイズ, [4]日付）
　　ReDim outputData(1 To totalCount, 1 To 5)
　　For i = 1 To totalCount
　　　　Dim item() As Variant
　　　　item = outputList(i)
　　　　
　　　　' データの変換と整形（A列:フォルダパス, B列:名前, C列:種類, D列:サイズ, E列:更新日時）
　　　　outputData(i, 1) = CStr(item(0))
　　　　outputData(i, 2) = CStr(item(1))
　　　　outputData(i, 3) = IIf(CBool(item(2)), "フォルダ", "ファイル")
　　　　outputData(i, 4) = IIf(CBool(item(2)), "", CLng(item(3)))
　　　　outputData(i, 5) = item(4)
　　Next
　　
　　' データを一括でシートに書き出し
　　ws.Cells(RESULT_START_ROW, 1).Resize(totalCount, 5).Value = outputData
　　
　　' 書式設定
　　With ws
　　　　' D列: サイズ (KB)
　　　　With .Range(.Cells(RESULT_START_ROW, 4), .Cells(RESULT_START_ROW + totalCount - 1, 4))
　　　　　　.NumberFormatLocal = "#,##0 ""KB"""
　　　　　　.HorizontalAlignment = xlRight
　　　　End With
　　　　' E列: 日付
　　　　With .Range(.Cells(RESULT_START_ROW, 5), .Cells(RESULT_START_ROW + totalCount - 1, 5))
　　　　　　.NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
　　　　　　.HorizontalAlignment = xlCenter
　　　　End With
　　End With
　　
　　' 処理時間の計算
　　Dim elapsedTime As Double
　　elapsedTime = Timer - startTime
　　
　　Call EndOptimization(calcMode)
　　
　　MsgBox "ファイル一覧の取得が完了しました。" & vbCrLf & vbCrLf & _
　　　　　　"件数: " & Format(totalCount, "#,##0") & " 件" & vbCrLf & _
　　　　　　"処理時間: " & Format(elapsedTime, "0.00") & " 秒", _
　　　　　　vbInformation, "完了"
　　
　　Set outputList = Nothing
　　Exit Sub
　　
ErrorHandler:
　　' エラー発生時の復帰処理
　　Set outputList = Nothing
　　Call EndOptimization(calcMode)
　　MsgBox "エラーが発生しました:" & vbCrLf & vbCrLf & _
　　　　　　"イミディエイトウィンドウで詳細を確認してください。", _
　　　　　　vbCritical, "エラー"
　　Debug.Print "エラー発生: " & Err.Number & " - " & Err.Description
End Sub

' ==========================================================
' 関数名: GetFileListWithDetails（修正後のDir検索ロジック）
' 目的: Dir関数による非再帰探索でファイルとフォルダのリストと詳細情報（サイズ、日時）をCollectionで返す。
' ==========================================================
Private Function GetFileListWithDetails(ByVal argDir As String, _
　　　　　　　　　　　　　　　　　　　　ByVal includeFolders As Boolean, _
　　　　　　　　　　　　　　　　　　　　ByVal includeFiles As Boolean) As Collection
　　
　　Dim aryDir() As String　　　　　　　　　　　　　　　' フォルダスタックとして機能
　　Dim strName As String
　　Dim i As Long
　　Dim resultCollection As New Collection　　　　　　　' 最終結果を格納
　　
　　' --- 1. 全てのサブフォルダのパスをaryDirに取得する（非再帰探索） ---
　　ReDim aryDir(0)
　　aryDir(0) = argDir ' 引数のフォルダを配列の先頭に入れる
　　
　　i = 0
　　Do
　　　　' 現在のフォルダ内のサブフォルダを列挙
　　　　On Error Resume Next ' アクセス権限エラーを回避
　　　　strName = Dir(aryDir(i) & "*", vbDirectory)
　　　　On Error GoTo 0
　　　　
　　　　Do While strName <> ""
　　　　　　If strName <> "." And strName <> ".." Then
　　　　　　　　Dim currentFullPath As String
　　　　　　　　currentFullPath = aryDir(i) & strName
　　　　　　　　
　　　　　　　　On Error Resume Next
　　　　　　　　If (GetAttr(currentFullPath) And vbDirectory) Then
　　　　　　　　　　' サブフォルダとしてaryDirに追加
　　　　　　　　　　ReDim Preserve aryDir(UBound(aryDir) + 1)
　　　　　　　　　　aryDir(UBound(aryDir)) = AddTrailingBackslash(currentFullPath)
　　　　　　　　End If
　　　　　　　　On Error GoTo 0
　　　　　　End If
　　　　　　strName = Dir()
　　　　Loop
　　　　
　　　　i = i + 1
　　　　If i > UBound(aryDir) Then Exit Do
　　Loop
　　
　　' --- 2. aryDirの全フォルダについて、ファイルとフォルダの詳細情報を取得 ---
　　For i = 0 To UBound(aryDir)
　　　　Dim currentFolder As String
　　　　currentFolder = aryDir(i)
　　　　
　　　　' Dir関数でファイルとフォルダを列挙するための属性
　　　　Const FILE_ATTR As Long = vbNormal Or vbHidden Or vbReadOnly Or vbSystem Or vbDirectory
　　　　
　　　　' フォルダ内のファイル/フォルダを列挙
　　　　On Error Resume Next ' Dir検索開始時のアクセスエラーを無視
　　　　strName = Dir(currentFolder & "*", FILE_ATTR)
　　　　If Err.Number <> 0 Then
　　　　　　Debug.Print "Dirアクセスエラー（スキップ）: " & currentFolder & " - " & Err.Description
　　　　　　Err.Clear
　　　　End If
　　　　On Error GoTo 0
　　　　
　　　　Do While strName <> ""
　　　　　　If strName <> "." And strName <> ".." Then
　　　　　　　　Dim isFolder As Boolean
　　　　　　　　Dim fileSizeKB As Long
　　　　　　　　Dim fileDate As Variant ' DateまたはNull
　　　　　　　　
　　　　　　　　On Error Resume Next
　　　　　　　　
　　　　　　　　' 属性を再取得してフォルダかファイルか判別
　　　　　　　　isFolder = (GetAttr(currentFolder & strName) And vbDirectory)
　　　　　　　　
　　　　　　　　If isFolder Then
　　　　　　　　　　' フォルダ
　　　　　　　　　　If includeFolders Then
　　　　　　　　　　　　fileSizeKB = 0
　　　　　　　　　　　　fileDate = "" ' Dir/GetAttrではフォルダの日時を取得できないため空
　　　　　　　　　　　　' 結果に追加
　　　　　　　　　　　　resultCollection.Add Array(currentFolder, strName, True, fileSizeKB, fileDate)
　　　　　　　　　　End If
　　　　　　　　Else
　　　　　　　　　　' ファイル
　　　　　　　　　　If includeFiles Then
　　　　　　　　　　　　' FileLenは2GB制限があるが、VBA標準機能ではこれが限界
　　　　　　　　　　　　fileSizeKB = CLng((FileLen(currentFolder & strName) + 1023) \ 1024)
　　　　　　　　　　　　fileDate = FileDateTime(currentFolder & strName)
　　　　　　　　　　　　
　　　　　　　　　　　　' 結果に追加
　　　　　　　　　　　　resultCollection.Add Array(currentFolder, strName, False, fileSizeKB, fileDate)
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　　　
　　　　　　　　If Err.Number <> 0 Then
　　　　　　　　　　' FileLen/FileDateTimeの呼び出しでエラーが発生した場合
　　　　　　　　　　Debug.Print "Dir/File操作エラー（スキップ）: " & currentFolder & strName & " - " & Err.Description
　　　　　　　　　　Err.Clear
　　　　　　　　End If
　　　　　　　　On Error GoTo 0
　　　　　　End If
　　　　　　
　　　　　　strName = Dir() ' 次のファイル/フォルダを取得
　　　　Loop
　　Next
　　
　　Set GetFileListWithDetails = resultCollection
End Function

' ==========================================================
' 関数名: AddTrailingBackslash (共通関数)
' 目的: パス文字列の末尾にバックスラッシュ(\)がない場合、それを追加する。
' ==========================================================
Private Function AddTrailingBackslash(ByVal targetPath As String) As String
　　If Right$(targetPath, 1) <> "\" Then
　　　　AddTrailingBackslash = targetPath & "\"
　　Else
　　　　AddTrailingBackslash = targetPath
　　End If
End Function

' ==========================================================
' 処理開始時の設定最適化を行う。
' ==========================================================
Sub StartOptimization(ByRef calcMode As Long)
　　calcMode = Application.calculation　　　　　　　' 現在の計算モードを保存
　　Application.calculation = xlCalculationManual　 ' 自動計算を停止
　　Application.ScreenUpdating = False　　　　　　　' 画面更新を停止
End Sub

' ==========================================================
' 処理終了時に設定を元に戻す。
' ==========================================================
Sub EndOptimization(ByRef calcMode As Long)
　　Application.ScreenUpdating = True　　　　　　　 ' 画面更新を再開
　　Application.calculation = calcMode　　　　　　　' 計算を元に戻す (処理開始時の設定に戻す)
End Sub

VBAコード解説
このVBAコードは、前回作成したFSO版の機能（サブフォルダを含む全ファイル/フォルダ一覧の取得と詳細情報の収集、Excelへの一括出力）を、Dir関数とGetAttr、FileLen、FileDateTime関数といったVBAの標準機能だけで実現するように修正したものです。

このVBAコードは、FSO (FileSystemObject) を利用して、指定したフォルダ内のファイルおよびサブフォルダの一覧を再帰的に取得し、その結果をExcelシートに出力するためのものです。

特に、Dir関数が再帰処理（Functionが自分自身を呼び出す）に向かないという制約を、配列をスタック（キュー）として利用した「非再帰探索」という高度な手法で回避している点が特徴です。

  1. メインプロシージャ: ファイル一覧取得_Dir関数版 の解説
    メインプロシージャの役割は、FSO版と同様に「環境の最適化」と「結果の整形・出力」に徹しています。
    1. 環境最適化
      • Call StartOptimization(calcMode) により、画面更新と自動計算を停止し、処理速度を向上させています。
    2. 検索実行
      • Set outputList = GetFileListWithDetails(rootDir, ...) により、検索ロジックを担う関数を呼び出します。
      • FSO版と同様に、A1セルから取得したルートパスと、検索対象（フォルダ/ファイル）のフラグを渡しています。
      • この関数が、サブフォルダを含む全検索と詳細情報の取得を担い、結果を Collection で返します。
    3. データ整形と出力
      • totalCount = outputList.Count で総件数を取得します。
      • ReDim outputData(1 To totalCount, 1 To 5) で、Excelシートへの一括書き出しに最適な2次元配列を準備します。
      • For i = 1 To totalCount ループ内で、outputList から取得したデータを、Excel表示に適した形式（例: Booleanを「フォルダ/ファイル」に、サイズをCLng型に）に変換し、outputData 配列に格納します。
      • ws.Cells(RESULT_START_ROW, 1).Resize(totalCount, 5).Value = outputData により、結果配列をシートに一括で書き出し、高速に描画します。
    4. 終了処理
      • 書式設定を行い、Call EndOptimization(calcMode) で環境を元に戻した後、処理時間と件数を表示して終了します。

  2. 検索ロジック: GetFileListWithDetails 関数の解説（コア部分）
    この関数が、Dir関数だけでサブフォルダを網羅的に検索し、ファイルの詳細情報を取得する核となるロジックです。
    1. 全てのサブフォルダのパスを取得（非再帰探索）
      Dir関数がシングルトンである（複数の階層を同時に開けない）という制約を回避するため、再帰を使わず、aryDir配列を「次に処理すべきフォルダのリスト（スタック/キュー）」として利用し、ループで階層をたどっています。
      • aryDir(): 検索すべきフォルダのパスを格納する配列です。
      • i (インデックス): 既に処理が完了したフォルダを追跡するカウンターです。
      • Do While i <= UBound(aryDir): ループを回すたびに、aryDir(i) のフォルダを処理し、i をインクリメントします。その処理中に見つかった新しいサブフォルダは ReDim Preserve で aryDir の末尾に追加されます。これにより、i が全ての要素を処理し終わるまでループが継続され、結果的に全サブフォルダを網羅できます。
      • On Error Resume Next でアクセス権のないフォルダのエラーを回避し、処理が中断しないようにしています。
    2. ファイル・フォルダの詳細情報を取得
      ステップ1で取得した全てのフォルダパス（aryDir）を順番に処理し、各フォルダ直下のファイル/フォルダの詳細情報を取得します。
      • 列挙
        • strName = Dir(currentFolder & "*", FILE_ATTR) で、指定属性（通常、隠し、システム、ディレクトリなど）を持つ全てのファイル・フォルダを列挙します。
      • 情報取得の工夫
        • Dir関数自体はサイズや日時を返さないため、ファイルであることが判明した後で、FileLen 関数（サイズ）とFileDateTime 関数（更新日時）を呼び出して情報を取得しています。
        • これらの関数呼び出し時もアクセスエラーが発生しやすいため、ここでも On Error Resume Next を適切に使用し、エラー発生時は値を空にして処理を継続するように設計されています。
      • 格納形式
        • resultCollection.Add Array(フォルダパス, 名前, IsFolder(Boolean), サイズKB, 日時) という5要素のVariant配列をCollectionに格納しています。これはFSO版と同じデータ構造であり、後のExcelへの一括出力処理の互換性を保証しています。

  3. 補助プロシージャ
    • AddTrailingBackslash 関数
      パス文字列 (targetPath) を受け取り、その末尾がバックスラッシュ (\) で終わっていない場合に、自動的にバックスラッシュを追加します。
      パスの連結時 (ParentFolder.Path & Name のような処理) に、バックスラッシュの有無を気にせず常に正しいフルパスを生成できるようにし、コードの可読性を高めます。
    • StartOptimization / EndOptimization サブプロシージャ
      Excelのパフォーマンスを最大化するために、マクロ実行前後の環境設定を自動で行います。
      • StartOptimization
        現在の計算モードを calcMode に保存します。
        Application.Calculation = xlCalculationManual で自動計算を停止します。
        Application.ScreenUpdating = False で画面更新を停止します。
      • EndOptimization
        ScreenUpdating = True で画面更新を再開します。
        保存しておいた calcMode に戻し、計算モードを復元します。


ファイル一覧取得：FSO(FileSystemObject) 版

標準モジュール
Option Explicit

' ==========================================================
' プロシージャ名: ファイル一覧取得_FSO版
' 目的: 指定されたフォルダ配下のファイルおよびフォルダの一覧をFSOで取得し、Excelシートに出力する。
' 処理概要:
' 1. FSO (FileSystemObject) を使用し、指定パスを再帰的に検索する。
' 2. 検索中は、画面更新停止や計算手動化 によりExcelの動作を最適化する。
' 3. 取得した全件の結果データを配列で整形した後、シートに一括で書き出し高速化する。
' 4. 処理終了後、環境設定を元に戻すとともに、完了メッセージを表示する。
' ==========================================================
Sub ファイル一覧取得_FSO版()
　　
　　Dim fso As Object　　　　　　　　　　　　　　　 ' FileSystemObject
　　Dim rootFolder As Object　　　　　　　　　　　　' 検索対象のルートフォルダ
　　Dim rootDir As String　　　　　　　　　　　　　 ' 検索対象のルートフォルダパス (A1セルから取得)
　　Dim ws As Worksheet　　　　　　　　　　　　　　 ' 結果を出力するワークシート
　　Dim i As Long
　　Dim outputList As Collection　　　　　　　　　　' 検索結果を格納するCollection
　　Dim outputData() As Variant　　　　　　　　　　 ' 最終的にシートに書き出すための整形済み2次元配列
　　Dim totalCount As Long
　　Dim startTime As Double
　　Dim calcMode As Long
　　
　　' 定数設定（検索設定と出力設定）
　　Const IS_RECURSIVE As Boolean = True　　　　　　 ' 【検索の深さ】FSO版では再帰検索のみを想定
　　Const INCLUDE_FOLDERS As Boolean = True　　　　　' 【含める種類】結果にフォルダ（ディレクトリ）を含めるか
　　Const INCLUDE_FILES As Boolean = True　　　　　　' 【含める種類】結果にファイルを含めるか
　　Const HEADER_ROW As Long = 3　　　　　　　　　　 ' 【出力先】ヘッダー（見出し）を出力する行番号
　　Const RESULT_START_ROW As Long = 4　　　　　　　 ' 【出力先】検索結果のデータを出力開始する行番号
　　
　　On Error GoTo ErrorHandler
　　
　　Set ws = ActiveSheet
　　
　　' パスの取得と検証
　　rootDir = Trim(CStr(ws.Cells(1, 1).Value))
　　If rootDir = "" Then
　　　　MsgBox "フォルダパスが指定されていません。", vbExclamation, "エラー"
　　　　Exit Sub
　　End If
　　
　　' FSOオブジェクトの作成
　　Set fso = CreateObject("Scripting.FileSystemObject")
　　
　　If Not fso.FolderExists(rootDir) Then
　　　　MsgBox "指定のフォルダは存在しません:" & vbCrLf & rootDir, vbExclamation, "エラー"
　　　　Exit Sub
　　End If
　　
　　Set rootFolder = fso.GetFolder(rootDir)
　　Set outputList = New Collection　　　　　　　　 ' 結果を一時的に格納するコレクション
　　
　　startTime = Timer
　　Call StartOptimization(calcMode)　　　　　　　　' 自動計算と画面更新を停止
　　
　　' ヘッダー行の設定
　　With ws.Cells(HEADER_ROW, 1).Resize(, 5)
　　　　.Value = Array("フォルダパス", "名前", "種類", "サイズ", "更新日時")
　　　　.Font.Bold = True
　　　　.Interior.Color = RGB(200, 200, 200)
　　　　.HorizontalAlignment = xlCenter
　　End With
　　
　　' FSO検索の実行（再帰サブルーチンを呼び出し）
　　' FSO版では、ルートフォルダ直下の結果も再帰関数内で処理させる
　　Call SearchFolder_FSO(rootFolder, IS_RECURSIVE, INCLUDE_FOLDERS, INCLUDE_FILES, outputList, ws, fso)
　　
　　totalCount = outputList.Count
　　
　　' 過去のデータをクリア
　　ws.Range(ws.Cells(RESULT_START_ROW, 1), ws.Cells(ws.Rows.Count, 5)).ClearContents
　　
　　' 結果が0件の場合の処理
　　If totalCount = 0 Then
　　　　Call EndOptimization(calcMode)
　　　　MsgBox "対象となるファイル/フォルダが見つかりませんでした。", vbInformation, "結果"
　　　　Set rootFolder = Nothing: Set fso = Nothing: Set outputList = Nothing
　　　　Exit Sub
　　End If
　　
　　' 出力用配列の準備（[0]フォルダパス, [1]名前, [2]種類, [3]サイズ, [4]日付）
　　ReDim outputData(1 To totalCount, 1 To 5)
　　
　　' データの変換と整形（A列:フォルダパス, B列:名前, C列:種類, D列:サイズ, E列:更新日時）
　　For i = 1 To totalCount
　　　　Dim item() As Variant
　　　　item = outputList(i)
　　　　outputData(i, 1) = CStr(item(0))
　　　　outputData(i, 2) = CStr(item(1))
　　　　outputData(i, 3) = IIf(CBool(item(2)), "フォルダ", "ファイル")
　　　　outputData(i, 4) = IIf(CBool(item(2)), "", CLng(item(3)))
　　　　outputData(i, 5) = item(4)
　　Next
　　
　　' データを一括でシートに書き出し
　　ws.Cells(RESULT_START_ROW, 1).Resize(totalCount, 5).Value = outputData
　　
　　' 書式設定
　　With ws
　　　　' D列: サイズ (KB)
　　　　With .Range(.Cells(RESULT_START_ROW, 4), .Cells(RESULT_START_ROW + totalCount - 1, 4))
　　　　　　.NumberFormatLocal = "#,##0 ""KB"""
　　　　　　.HorizontalAlignment = xlRight
　　　　End With
　　　　' E列: 日付
　　　　With .Range(.Cells(RESULT_START_ROW, 5), .Cells(RESULT_START_ROW + totalCount - 1, 5))
　　　　　　.NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
　　　　　　.HorizontalAlignment = xlCenter
　　　　End With
　　End With
　　
　　' 処理時間の計算
　　Dim elapsedTime As Double
　　elapsedTime = Timer - startTime
　　
　　Call EndOptimization(calcMode)
　　
　　MsgBox "ファイル一覧の取得が完了しました。" & vbCrLf & vbCrLf & _
　　　　　 "件数: " & Format(totalCount, "#,##0") & " 件" & vbCrLf & _
　　　　　 "処理時間: " & Format(elapsedTime, "0.00") & " 秒", _
　　　　　 vbInformation, "完了"
　　
　　Set rootFolder = Nothing
　　Set fso = Nothing
　　Set outputList = Nothing
　　Exit Sub
　　
ErrorHandler:
　　' エラー発生時の復帰処理
　　Set rootFolder = Nothing: Set fso = Nothing: Set outputList = Nothing
　　Call EndOptimization(calcMode)
　　MsgBox "エラーが発生しました:" & vbCrLf & vbCrLf & _
　　　　　 "イミディエイトウィンドウで詳細を確認してください。", _
　　　　　 vbCritical, "エラー"
　　Debug.Print "エラー発生: " & Err.Number & " - " & Err.Description
End Sub

' ==========================================================
' FSO検索の再帰処理サブルーチン
' ==========================================================
Private Sub SearchFolder_FSO( _
　　ByRef targetFolder As Object, _
　　ByVal isRecursive As Boolean, _
　　ByVal includeFolders As Boolean, _
　　ByVal includeFiles As Boolean, _
　　ByRef outputList As Collection, _
　　ByRef ws As Object, _
　　ByRef fso As Object)
　　
　　On Error GoTo ErrorHandler
　　
　　Dim subFolder As Object
　　Dim fsoFile As Object
　　
　　' 1. 現在のフォルダの情報をコレクションに追加 (ルートフォルダ自身は除く)
　　If targetFolder.Path <> fso.GetFolder(ws.Cells(1, 1).Value).Path Then
　　　　If includeFolders Then
　　　　　　 ' フォルダの情報をVariant配列にまとめてCollectionに追加
　　　　　　 outputList.Add Array(AddTrailingBackslash(targetFolder.ParentFolder.Path), _
　　　　　　　　　　　　　　　　　targetFolder.Name, _
　　　　　　　　　　　　　　　　　True, _
　　　　　　　　　　　　　　　　　0, _
　　　　　　　　　　　　　　　　　targetFolder.DateLastModified)
　　　　End If
　　End If
　　
　　' 2. ファイルを列挙
　　If includeFiles Then
　　　　For Each fsoFile In targetFolder.Files
　　　　　　outputList.Add Array(AddTrailingBackslash(targetFolder.Path), _
　　　　　　　　　　　　　　　　 fsoFile.Name, _
　　　　　　　　　　　　　　　　 False, _
　　　　　　　　　　　　　　　　 CLng((fsoFile.Size + 1023) \ 1024), _
　　　　　　　　　　　　　　　　 fsoFile.DateLastModified)
　　　　Next fsoFile
　　End If
　　
　　' 3. サブフォルダを再帰的に処理
　　If isRecursive Then
　　　　For Each subFolder In targetFolder.SubFolders
　　　　　　' アクセス権限エラーなどを無視するため、エラーハンドリングを再定義
　　　　　　On Error Resume Next
　　　　　　' 再帰呼び出し
　　　　　　Call SearchFolder_FSO(subFolder, isRecursive, includeFolders, includeFiles, outputList, ws, fso)
　　　　　　If Err.Number <> 0 Then
　　　　　　　　Debug.Print "FSOアクセスエラー（スキップ）: " & subFolder.Path & " - " & Err.Description
　　　　　　　　' エラー発生後、エラーハンドリングをリセット
　　　　　　　　On Error GoTo ErrorHandler
　　　　　　End If
　　　　　　On Error GoTo ErrorHandler
　　　　Next subFolder
　　End If
　　
　　Exit Sub
　　
ErrorHandler:
　　' FSOはエラーが発生しやすいため、ここでは致命的なエラーのみ処理
　　Debug.Print "FSO処理中の予期せぬエラー: " & Err.Description
End Sub

' ==========================================================
' 関数名: AddTrailingBackslash
' 目的: パス文字列の末尾にバックスラッシュ(\)がない場合、それを追加する。
' 引数: targetPath (String): 処理対象のパス
' 戻り値: 末尾にバックスラッシュが付加されたパス (String)
' ==========================================================
Private Function AddTrailingBackslash(ByVal targetPath As String) As String
　　If Right$(targetPath, 1) <> "\" Then
　　　　AddTrailingBackslash = targetPath & "\"
　　Else
　　　　AddTrailingBackslash = targetPath
　　End If
End Function

' ==========================================================
' 処理開始時の設定最適化を行う。
' ==========================================================
Sub StartOptimization(ByRef calcMode As Long)
　　calcMode = Application.calculation　　　　　　　' 現在の計算モードを保存
　　Application.calculation = xlCalculationManual　 ' 自動計算を停止
　　Application.ScreenUpdating = False　　　　　　　' 画面更新を停止
End Sub

' ==========================================================
' 処理終了時に設定を元に戻す。
' ==========================================================
Sub EndOptimization(ByRef calcMode As Long)
　　Application.ScreenUpdating = True　　　　　　　 ' 画面更新を再開
　　Application.calculation = calcMode　　　　　　　' 計算を元に戻す (処理開始時の設定に戻す)
End Sub

VBAコード解説
このVBAコードは、FSO (FileSystemObject) を利用して、指定したフォルダ内のファイルおよびサブフォルダの一覧を再帰的に取得し、その結果をExcelシートに出力するためのものです。
コードは主に、メイン処理 (ファイル一覧取得_FSO版)、再帰検索サブルーチン (SearchFolder_FSO)、および補助関数 (AddTrailingBackslash, Start/EndOptimization) の3つの部分で構成されています。
以下に、各プロシージャと主要な処理の解説をします。

  1. メインプロシージャ: ファイル一覧取得_FSO版
    このプロシージャは、処理の開始から終了までの流れを統括します。
    1. 初期設定と準備
      Option Explicit: 変数の宣言を強制します。
      変数の宣言: fso (FSOオブジェクト)、ws (ワークシート)、outputList (結果を一時格納するCollection) などを定義します。
      定数設定: 検索の深さ (IS_RECURSIVE) や、含める対象 (INCLUDE_FOLDERS, INCLUDE_FILES)、出力先の行 (HEADER_ROW, RESULT_START_ROW) を設定します。
    2. パスの取得と検証
      アクティブシートの A1セル からルートフォルダパス (rootDir) を取得します。
      CreateObject("Scripting.FileSystemObject") でFSOオブジェクトを生成し、fso.FolderExists メソッドでパスの存在を確認します。パスが存在しない場合はエラーメッセージを表示して終了します。
    3. 環境最適化とヘッダー設定
      Call StartOptimization(calcMode): 画面更新を停止し、自動計算を手動に切り替えて処理速度を向上させます。
      A3セルから始まるヘッダー行を設定します。
    4. 検索実行
      Call SearchFolder_FSO(...): 検索の中核となる再帰処理サブルーチンを呼び出し、FSOオブジェクトと設定フラグを渡して検索を実行させます。結果は outputList (Collection) に格納されます。
    5. 結果の書き出しと整形
      outputList.Count で総件数 (totalCount) を取得します。
      過去の結果をクリアした後、ReDim outputData(...) で出力用の2次元配列を用意します。
      For i = 1 To totalCount ループで、Collection内のデータを1件ずつ取り出し、Excelで表示しやすい形式（フォルダ/ファイル判定、サイズのKB変換など）に整形しながら outputData 配列に格納します。
      ws.Cells(RESULT_START_ROW, 1).Resize(totalCount, 5).Value = outputData: 配列を一括でシートに書き出し、高速な出力処理を実現します。
    6. 書式設定と終了処理
      サイズ列(D列)と日付列(E列)に適切なExcelの書式を設定します。
      Call EndOptimization(calcMode): 処理前に停止した画面更新と計算モードを元に戻します。
      処理時間と結果件数をメッセージボックスに表示して終了します。
      ErrorHandler: 実行時エラーが発生した場合の復旧処理とメッセージ表示を行います。

  2. 再帰検索サブルーチン: SearchFolder_FSO
    FSOのオブジェクトモデルを利用して、フォルダを次々に探索していく再帰処理を行います。
    1. カレントフォルダ情報の追加
      If targetFolder.Path <> fso.GetFolder(ws.Cells(1, 1).Value).Path Then: 現在の targetFolder のパスが、A1セルで指定したルートフォルダ自身でない場合に限り、以下の処理を行います。
      If includeFolders Then: フォルダを含める設定の場合、targetFolder の情報をCollection (outputList) に追加します。
      targetFolder.ParentFolder.Path：親フォルダのパスを取得し、AddTrailingBackslash 関数を使って末尾にバックスラッシュ (\) を付加しています。
    2. ファイル情報の列挙と追加
      If includeFiles Then: ファイルを含める設定の場合、For Each fsoFile In targetFolder.Files ループで、現在のフォルダ直下のファイルを全て取得します。
      ファイル名、親パス (targetFolder.Path)、サイズ（KB変換）、更新日時を配列に格納し、outputList に追加します。
    3. サブフォルダの再帰処理
      If isRecursive Then: 再帰検索を行う設定の場合、For Each subFolder In targetFolder.SubFolders ループで、直下のサブフォルダを全て処理します。
      On Error Resume Next: FSOはアクセス権限のないフォルダでエラーを起こしやすいため、一時的にエラーを無視します（スキップ）。
      Call SearchFolder_FSO(...): 自分自身（SearchFolder_FSO）を呼び出し、次のフォルダ (subFolder) へ処理を移します（再帰）。
      エラーチェック: 呼び出し後にエラーが発生していた場合、その旨をイミディエイトウィンドウに出力し、エラーハンドリングを元に戻しています。

  3. 補助プロシージャ/関数
    • AddTrailingBackslash 関数
      パス文字列 (targetPath) を受け取り、その末尾がバックスラッシュ (\) で終わっていない場合に、自動的にバックスラッシュを追加します。
      パスの連結時 (ParentFolder.Path & Name のような処理) に、バックスラッシュの有無を気にせず常に正しいフルパスを生成できるようにし、コードの可読性を高めます。

    • StartOptimization / EndOptimization サブプロシージャ
      Excelのパフォーマンスを最大化するために、マクロ実行前後の環境設定を自動で行います。
      • StartOptimization
        現在の計算モードを calcMode に保存します。
        Application.Calculation = xlCalculationManual で自動計算を停止します。
        Application.ScreenUpdating = False で画面更新を停止します。
      • EndOptimization
        ScreenUpdating = True で画面更新を再開します。
        保存しておいた calcMode に戻し、計算モードを復元します。


ファイル一覧取得：Windows API (FindFirstFileW, FindNextFileW) 版

クラスモジュール

Option Explicit

' ==========================================================
' クラスモジュール名: CFileFinder (API完全統合版)
' 目的: Unicode APIによる高速・確実なファイル検索、存在確認、詳細情報取得を行う。
' ==========================================================

' --- 1. APIの宣言と構造体 ---

' ファイル検索を最初に開始するAPI (WideChar/Unicode版)
Private Declare PtrSafe Function FindFirstFile Lib "kernel32" Alias "FindFirstFileW" ( _
　　　　ByVal lpFileName As LongPtr, lpFindFileData As WIN32_FIND_DATA) As LongPtr
' 次のファイル/フォルダを検索するAPI
Private Declare PtrSafe Function FindNextFile Lib "kernel32" Alias "FindNextFileW" ( _
　　　　ByVal hFindFile As LongPtr, lpFindFileData As WIN32_FIND_DATA) As Long
' 検索ハンドルを閉じるAPI
Private Declare PtrSafe Function FindClose Lib "kernel32" ( _
　　　　ByVal hFindFile As LongPtr) As LongPtr
' エラーコードを取得するAPI
Private Declare PtrSafe Function GetLastError Lib "kernel32" () As Long
' ファイルまたはフォルダの属性を取得するAPI (存在確認や属性詳細情報取得に使用)
Private Declare PtrSafe Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesW" ( _
　　　　ByVal lpFileName As LongPtr) As Long

' API定数
Private Const INVALID_HANDLE_VALUE As LongPtr = -1　　' 検索失敗時のハンドル値
Private Const INVALID_FILE_ATTRIBUTES As Long = &HFFFFFFFF ' 属性取得失敗時の戻り値
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10 ' 検索結果がディレクトリであるか判別する属性値
' APIエラーコード（エラーハンドリング用）
Private Const ERROR_NO_MORE_FILES As Long = 18　　　　　　' 次のファイルがない（FindNextFileの終了条件）
Private Const ERROR_FILE_NOT_FOUND As Long = 2　　　　　　' ファイルが見つからない
Private Const ERROR_PATH_NOT_FOUND As Long = 3　　　　　　' パスが見つからない
Private Const ERROR_ACCESS_DENIED As Long = 5　　　　　　 ' アクセスが拒否された

' Windowsが使用するファイルの時間情報構造体
Private Type FILETIME
　　　　dwLowDateTime As Long　　　　　　　　　　　　　　　　　　　　　　　　　　 ' ファイル時間の下位32ビット
　　　　dwHighDateTime As Long　　　　　　　　　　　　　　　　　　　　　　　　　　' ファイル時間の上位32ビット
End Type

' API検索結果格納用の構造体（WIN32_FIND_DATAWに相当）
Private Type WIN32_FIND_DATA
　　　　dwFileAttributes As Long　　　　　　　　　　　　　　　　　　　　　　　　' ファイル属性 (GetFileInfoの属性値として使用)
　　　　ftCreationTime As FILETIME　　　　　　　　　　　　　　　　　　　　　　' 作成時刻
　　　　ftLastAccessTime As FILETIME　　　　　　　　　　　　　　　　　　　　' 最終アクセス時刻
　　　　ftLastWriteTime As FILETIME　　　　　　　　　　　　　　　　　　　　 ' 最終更新時刻 (結果表示に使用)
　　　　nFileSizeHigh As Long　　　　　　　　　　　　　　　　　　　　　　　　　　 ' ファイルサイズの上位32ビット
　　　　nFileSizeLow As Long　　　　　　　　　　　　　　　　　　　　　　　　　　　　' ファイルサイズの下位32ビット
　　　　dwReserved0 As Long　　　　　　　　　　　　　　　　　　　　　　　　　　　　 ' 予約
　　　　dwReserved1 As Long　　　　　　　　　　　　　　　　　　　　　　　　　　　　 ' 予約
　　　　cFileName(0 To 519) As Byte　　　　　　　　　　　　　　　　　　　　 ' ファイル名 (Unicode: 260文字 * 2バイト)
　　　　cAlternateFileName(0 To 27) As Byte　　　　　　　　　　　　 ' ショートファイル名 (Unicode: 14文字 * 2バイト)
End Type

' 検索結果を格納するための内部構造体
Private Type TSearchResult
　　　　folderPath As String　　　　　　　　　　　　　　　　　　　　　　　　　　　　' ファイルまたはフォルダの親フォルダパス
　　　　Name As String　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　' ファイルまたはフォルダ名
　　　　IsFolder As Boolean　　　　　　　　　　　　　　　　　　　　　　　　　　　　 ' フォルダかどうか (True: フォルダ, False: ファイル)
　　　　sizeKB As Long　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　' ファイルサイズ (キロバイト単位)
　　　　lastModified As Variant　　　　　　　　　　　　　　　　　　　　　　　　 ' 最終更新日時 (Date型またはNull)
End Type

' 再帰検索に使用するフォルダのパスを格納するスタック構造体（Collectionより高速）
Private Type TFolderStack
　　　　Paths() As String　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 ' フォルダパスの配列
　　　　Count As Long　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 ' 現在スタックに積まれているパスの数
　　　　Capacity As Long　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　' Paths配列の現在の最大要素数
End Type

' --- 2. クラス変数 ---

Private m_Results() As TSearchResult　　　　　　　　　　　　　　　　' 検索結果の格納配列
Private m_ResultCount As Long　　　　　　　　　　　　　　　　　　　　　　 ' 検索結果の総数
Private m_IsRecursive As Boolean　　　　　　　　　　　　　　　　　　　　' 再帰検索を行うかどうかのフラグ
Private m_IncludeFolders As Boolean　　　　　　　　　　　　　　　　 ' 検索結果にフォルダを含めるかどうかのフラグ
Private m_IncludeFiles As Boolean　　　　　　　　　　　　　　　　　　 ' 検索結果にファイルを含めるかどうかのフラグ
Private m_LastError As String　　　　　　　　　　　　　　　　　　　　　　 ' 検索中に発生した最終エラーメッセージ

' --- 3. Public インターフェース (公開メソッド/プロパティ) ---

' ==========================================================
' フォルダの存在確認 (API: GetFileAttributesW)
' 引数: path (String): チェック対象のフォルダパス
' 戻り値: 存在すれば True
' ==========================================================
Public Function IsDirectoryExists(ByVal path As String) As Boolean
　　　　IsDirectoryExists = GetFileAttributesAPI_Internal(path, True)
End Function

' ==========================================================
' ファイルの存在確認 (API: GetFileAttributesW)
' 引数: path (String): チェック対象のファイルパス
' 戻り値: 存在すれば True
' ==========================================================
Public Function IsFileExists(ByVal path As String) As Boolean
　　　　IsFileExists = GetFileAttributesAPI_Internal(path, False)
End Function

' ==========================================================
' ファイルの詳細情報（サイズ、日時、属性）を取得 (API: FindFirstFileW)
' 戻り値: Variant(0 To 6) の1次元配列として情報を返す
' 要素: [0]:Exists, [1]:IsFolder, [2]:Attributes, [3]:SizeKB, [4]:LastModified, [5]:ErrorMessage, [6]:SizeB(CDec)
' ==========================================================
Public Function GetFileInfo(ByVal filePath As String) As Variant
　　　　Dim data As WIN32_FIND_DATA
　　　　Dim hFile As LongPtr
　　　　Dim lastErr As Long
　　　　Dim info(0 To 6) As Variant ' 戻り値配列
　　　　
　　　　' 初期化
　　　　info(0) = False ' Exists
　　　　info(5) = ""　　　　' ErrorMessage
　　　　
　　　　' FindFirstFile 実行 (ファイル/フォルダの情報を1件取得)
　　　　hFile = FindFirstFile(ByVal StrPtr(filePath), data)
　　　　
　　　　If hFile = INVALID_HANDLE_VALUE Then
　　　　　　　　lastErr = GetLastError()
　　　　　　　　info(5) = "APIエラー " & lastErr
　　　　　　　　GoTo ExitFunction
　　　　End If
　　　　
　　　　' 情報の格納
　　　　info(0) = True ' Exists
　　　　info(2) = data.dwFileAttributes ' Attributes (インデックス2)
　　　　info(1) = (data.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> 0 ' IsFolder
　　　　
　　　　If info(1) = False Then ' ファイルの場合のみサイズと日時を取得
　　　　　　　　' サイズを計算 (64bit値を格納)
　　　　　　　　Dim sizeB As Variant
　　　　　　　　sizeB = CDec(data.nFileSizeHigh) * 4294967296# + data.nFileSizeLow
　　　　　　　　info(6) = sizeB　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 ' SizeB (インデックス6)
　　　　　　　　info(3) = CLng((CDec(sizeB) + 1023) \ 1024)　　　　 ' SizeKB (インデックス3)
　　　　　　　　' 最終更新日時を取得
　　　　　　　　info(4) = FileTimeToDate(data.ftLastWriteTime)　　' LastModified (インデックス4)
　　　　Else ' フォルダの場合、サイズと日時を空にする
　　　　　　　　info(6) = 0
　　　　　　　　info(3) = 0
　　　　　　　　info(4) = Null
　　　　End If
　　　　
　　　　' FindCloseでハンドルを閉じる
　　　　Call FindClose(hFile)
　　　　
ExitFunction:
　　　　GetFileInfo = info
End Function

' ==========================================================
' ファイル検索を開始します。
' ==========================================================
Public Sub StartSearch( _
　　　　ByVal rootPath As String, _
　　　　Optional ByVal isRecursive As Boolean = True, _
　　　　Optional ByVal includeFolders As Boolean = True, _
　　　　Optional ByVal includeFiles As Boolean = True)
　　　　
　　　　On Error GoTo ErrorHandler
　　　　
　　　　' 初期化
　　　　m_ResultCount = 0
　　　　m_LastError = ""
　　　　ReDim m_Results(1 To 1000)
　　　　m_IsRecursive = isRecursive
　　　　m_IncludeFolders = includeFolders
　　　　m_IncludeFiles = includeFiles
　　　　
　　　　' パスの正規化
　　　　rootPath = Trim$(rootPath)
　　　　If rootPath = "" Then
　　　　　　　　m_LastError = "パスが空です"
　　　　　　　　Exit Sub
　　　　End If
　　　　
　　　　Do While Right$(rootPath, 1) = "\"
　　　　　　　　rootPath = Left$(rootPath, Len(rootPath) - 1)
　　　　Loop
　　　　rootPath = rootPath & "\"
　　　　
　　　　' 検索実行 (Private関数を呼び出す)
　　　　Call IterativeSearch(rootPath)
　　　　
　　　　Exit Sub
　　　　
ErrorHandler:
　　　　m_LastError = "StartSearch エラー: " & Err.Description
End Sub

' ==========================================================
' 検索結果を2次元のVariant配列として返します。
' 戻り値: 検索結果を含むVariant配列 (5列: フォルダパス, 名前, 種類, サイズKB, 更新日時)
' ==========================================================
Public Property Get Results() As Variant
　　　　Dim outputArray() As Variant
　　　　Dim i As Long
　　　　
　　　　If m_ResultCount = 0 Then
　　　　　　　　' 結果がない場合、エラー値を格納した配列を返す (空の配列は不可のため)
　　　　　　　　ReDim outputArray(1 To 1, 1 To 5)
　　　　　　　　outputArray(1, 1) = CVErr(xlErrValue)
　　　　Else
　　　　　　　　' 結果を2次元Variant配列に詰め替える
　　　　　　　　ReDim outputArray(1 To m_ResultCount, 1 To 5)
　　　　　　　　For i = 1 To m_ResultCount
　　　　　　　　　　　　outputArray(i, 1) = m_Results(i).folderPath
　　　　　　　　　　　　outputArray(i, 2) = m_Results(i).Name
　　　　　　　　　　　　outputArray(i, 3) = m_Results(i).IsFolder
　　　　　　　　　　　　outputArray(i, 4) = m_Results(i).sizeKB
　　　　　　　　　　　　outputArray(i, 5) = m_Results(i).lastModified
　　　　　　　　Next i
　　　　End If
　　　　Results = outputArray
End Property

' ==========================================================
' 検索結果の総件数を返します。
' ==========================================================
Public Property Get Count() As Long
　　　　Count = m_ResultCount
End Property

' ==========================================================
' 検索中に発生した最終エラーメッセージを返します。
' ==========================================================
Public Property Get LastError() As String
　　　　LastError = m_LastError
End Property

' --- 4. Private ユーティリティ関数 ---

' ==========================================================
' APIによるファイル/フォルダの存在確認ロジック（内部関数）
' GetFileAttributesWを使用して、存在と種類（ファイル/フォルダ）を判定する。
' ==========================================================
Private Function GetFileAttributesAPI_Internal(ByVal path As String, ByVal checkFolder As Boolean) As Boolean
　　　　
　　　　' 末尾のバックスラッシュを削除 (GetFileAttributesWの仕様に合わせる)
　　　　Do While Right$(path, 1) = "\"
　　　　　　　　path = Left$(path, Len(path) - 1)
　　　　Loop
　　　　
　　　　Dim fileAttributes As Long
　　　　fileAttributes = GetFileAttributes(ByVal StrPtr(path)) ' API呼び出し
　　　　
　　　　If fileAttributes = INVALID_FILE_ATTRIBUTES Then
　　　　　　　　GetFileAttributesAPI_Internal = False
　　　　　　　　Exit Function
　　　　End If
　　　　
　　　　' 属性からフォルダかどうかを判定
　　　　Dim isDirectory As Boolean
　　　　isDirectory = (fileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> 0
　　　　
　　　　If checkFolder Then
　　　　　　　　' フォルダチェックの場合、フォルダならTrue
　　　　　　　　GetFileAttributesAPI_Internal = isDirectory
　　　　Else
　　　　　　　　' ファイルチェックの場合、フォルダでなければTrue
　　　　　　　　GetFileAttributesAPI_Internal = Not isDirectory
　　　　End If
End Function

' ==========================================================
' WIN32 APIのFILETIME構造体をExcelの日付/時刻 (Date/Double) に変換します。
' ==========================================================
Private Function FileTimeToDate(ByRef ft As FILETIME) As Variant
　　　　On Error GoTo ErrorHandler
　　　　
　　　　If ft.dwHighDateTime = 0 And ft.dwLowDateTime = 0 Then
　　　　　　　　FileTimeToDate = Null ' 0は無効な時刻としてNullを返す
　　　　　　　　Exit Function
　　　　End If
　　　　
　　　　' FILETIME は 1601年1月1日からの100ナノ秒単位
　　　　' 64ビット整数値に変換：FILETIMEの64ビット値を格納 (Decimal型を使用)
　　　　Dim fileTime64 As Variant
　　　　fileTime64 = CDec(ft.dwHighDateTime) * 4294967296# + CDec(ft.dwLowDateTime)
　　　　
　　　　' 100ナノ秒単位を日数に変換
　　　　Dim days As Double
　　　　days = fileTime64 / 864000000000#
　　　　
　　　　' 1601年1月1日から1899年12月30日(Excel基準日)までの日数を引く
　　　　Dim excelDate As Double
　　　　excelDate = days - 109205#
　　　　
　　　　' 有効な日付範囲チェック
　　　　If excelDate < 1 Or excelDate > 2958465 Then
　　　　　　　　FileTimeToDate = Null
　　　　Else
　　　　　　　　FileTimeToDate = CDate(excelDate)
　　　　End If
　　　　Exit Function
　　　　
ErrorHandler:
　　　　Debug.Print "FileTimeToDate エラー: " & Err.Description
　　　　FileTimeToDate = Null
End Function

' ==========================================================
' 検索結果 (1件) を内部配列 m_Results に追加します。
' 配列のキャパシティが不足している場合は拡張します。
' ==========================================================
Private Sub AddResult(ByVal folderPath As String, ByVal Name As String, _
　　　　　　　　　　　　　　　　　　　　　　ByVal IsFolder As Boolean, ByVal sizeKB As Long, _
　　　　　　　　　　　　　　　　　　　　　　ByVal lastModified As Variant)
　　　　m_ResultCount = m_ResultCount + 1

　　　　' 配列のリサイズ（1000件ずつ拡張）
　　　　If m_ResultCount > UBound(m_Results) Then
　　　　　　　　ReDim Preserve m_Results(1 To m_ResultCount + 1000)
　　　　End If

　　　　With m_Results(m_ResultCount)
　　　　　　　　' 各フィールドに結果を格納
　　　　　　　　.folderPath = folderPath
　　　　　　　　.Name = Name
　　　　　　　　.IsFolder = IsFolder
　　　　　　　　.sizeKB = sizeKB
　　　　　　　　.lastModified = lastModified
　　　　End With
End Sub

' ==========================================================
' WIN32_FIND_DATA内のByte配列からNull終端のファイル名をStringとして取り出します。
' ==========================================================
Private Function GetFileNameFromBytes(ByRef byteArray() As Byte) As String
　　　　Dim tempStr As String　　　　　　　　　　　　　　　　　　　　　　　　　　 ' Byte配列を文字列として一時的に格納
　　　　tempStr = byteArray

　　　　' Null文字で切り取り
　　　　Dim nullPos As Long
　　　　nullPos = InStr(tempStr, vbNullChar)
　　　　If nullPos > 0 Then
　　　　　　　　GetFileNameFromBytes = Left$(tempStr, nullPos - 1)
　　　　Else
　　　　　　　　GetFileNameFromBytes = tempStr
　　　　End If
End Function

' ==========================================================
' フォルダスタックを初期化します。
' ==========================================================
Private Sub InitStack(ByRef stack As TFolderStack)
　　　　stack.Capacity = 100　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　' 初期キャパシティ
　　　　stack.Count = 0　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 ' カウントをリセット
　　　　ReDim stack.Paths(1 To stack.Capacity)　　　　　　　　　　　　　　' 配列を初期化
End Sub

' ==========================================================
' フォルダパスをスタックに積みます (Push)。
' ==========================================================
Private Sub PushStack(ByRef stack As TFolderStack, ByVal folderPath As String)
　　　　stack.Count = stack.Count + 1
　　　　If stack.Count > stack.Capacity Then
　　　　　　　　stack.Capacity = stack.Capacity + 100
　　　　　　　　ReDim Preserve stack.Paths(1 To stack.Capacity) ' 配列を拡張
　　　　End If
　　　　stack.Paths(stack.Count) = folderPath　　　　　　　　　　　　　　 ' パスを格納
End Sub

' ==========================================================
' スタックからフォルダパスを取り出します (Pop)。
' ==========================================================
Private Function PopStack(ByRef stack As TFolderStack) As String
　　　　If stack.Count > 0 Then
　　　　　　　　PopStack = stack.Paths(stack.Count)　　　　　　　　　　　　 ' パスを取得
　　　　　　　　stack.Count = stack.Count - 1　　　　　　　　　　　　　　　　　　 ' カウントを減らす
　　　　Else
　　　　　　　　PopStack = ""　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 ' スタックが空の場合は空文字を返す
　　　　End If
End Function

' --- 5. Private 検索ロジック（反復関数） ---

' ==========================================================
' APIを用いたファイル/フォルダの再帰的検索を非再帰（反復）で行います。
' ==========================================================
Private Sub IterativeSearch(ByVal rootPath As String)
　　　　On Error GoTo ErrorHandler

　　　　Dim data As WIN32_FIND_DATA　　　　　　　　　　　　　　　　　　　　　　　　 ' APIから返される検索結果データ
　　　　Dim hFile As LongPtr　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　' FindFirstFile/FindNextFileの検索ハンドル
　　　　Dim fileName As String　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　' 抽出されたファイル/フォルダ名
　　　　Dim currentPath As String　　　　　　　　　　　　　　　　　　　　　　　　　　 ' 現在検索中のフォルダパス
　　　　Dim folderStack As TFolderStack　　　　　　　　　　　　　　　　　　　　 ' 次に探索すべきフォルダを格納するスタック
　　　　Dim searchPath As String　　　　　　　　　　　　　　　　　　　　　　　　　　　　' FindFirstFileに渡す検索パターン (例: "C:\Root\*")
　　　　Dim sizeB As Variant　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　' ファイルサイズ (64bit値を格納するためVariant/CDecを想定)
　　　　Dim sizeKB As Long　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　' ファイルサイズ (KB単位)
　　　　Dim lastModified As Variant　　　　　　　　　　　　　　　　　　　　　　　　 ' 最終更新日時
　　　　Dim lastErr As Long　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 ' GetLastErrorで取得したエラーコード

　　　　' スタック初期化
　　　　Call InitStack(folderStack)
　　　　Call PushStack(folderStack, rootPath)　　　　　　　　　　　　　　 ' ルートパスをスタックに積む

　　　　hFile = INVALID_HANDLE_VALUE　　　　　　　　　　　　　　　　　　　　　　　　' ハンドルを初期化

　　　　' スタックが空になるまでループ（非再帰の深さ優先探索）
　　　　Do While folderStack.Count > 0
　　　　　　　　currentPath = PopStack(folderStack)　　　　　　　　　　　　 ' スタックから次のフォルダを取り出す
　　　　　　　　searchPath = currentPath & "*"　　　　　　　　　　　　　　　　　　' 検索パターンを設定

　　　　　　　　' FindFirstFile 実行
　　　　　　　　hFile = FindFirstFile(ByVal StrPtr(searchPath), data)

　　　　　　　　If hFile = INVALID_HANDLE_VALUE Then
　　　　　　　　　　　　lastErr = GetLastError()　　　　　　　　　　　　　　　　　　　　' エラーコードを取得
　　　　　　　　　　　　Select Case lastErr
　　　　　　　　　　　　　　　　Case ERROR_FILE_NOT_FOUND, ERROR_NO_MORE_FILES
　　　　　　　　　　　　　　　　' ファイルが見つからない（空フォルダなど）- 正常と見なす
　　　　　　　　　　　　　　　　Case ERROR_PATH_NOT_FOUND
　　　　　　　　　　　　　　　　　　　　m_LastError = m_LastError & vbCrLf & "パスが見つかりません: " & currentPath
　　　　　　　　　　　　　　　　Case ERROR_ACCESS_DENIED
　　　　　　　　　　　　　　　　　　　　m_LastError = m_LastError & vbCrLf & "アクセス拒否: " & currentPath
　　　　　　　　　　　　　　　　Case Else ' その他のエラー
　　　　　　　　　　　　　　　　　　　　m_LastError = m_LastError & vbCrLf & "FindFirstFile エラー " & lastErr & ": " & currentPath
　　　　　　　　　　　　End Select
　　　　　　　　　　　　GoTo NextFolder
　　　　　　　　End If

　　　　　　　　' ファイル/フォルダを列挙
　　　　　　　　Do
　　　　　　　　　　　　fileName = GetFileNameFromBytes(data.cFileName) ' Byte配列からファイル名を取得

　　　　　　　　　　　　If fileName <> "" And fileName <> "." And fileName <> ".." Then

　　　　　　　　　　　　　　　　' サイズと日時を計算
　　　　　　　　　　　　　　　　sizeB = CDec(data.nFileSizeHigh) * 4294967296# + data.nFileSizeLow
　　　　　　　　　　　　　　　　sizeKB = CLng((CDec(sizeB) + 1023) \ 1024)
　　　　　　　　　　　　　　　　lastModified = FileTimeToDate(data.ftLastWriteTime)
　　　　　　　　　　　　　　　　
　　　　　　　　　　　　　　　　If (data.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> 0 Then
　　　　　　　　　　　　　　　　　　　　' フォルダ
　　　　　　　　　　　　　　　　　　　　If m_IncludeFolders Then
　　　　　　　　　　　　　　　　　　　　　　　　' フォルダの結果を追加 (サイズは0KB)
　　　　　　　　　　　　　　　　　　　　　　　　Call AddResult(currentPath, fileName, True, 0, lastModified)
　　　　　　　　　　　　　　　　　　　　End If

　　　　　　　　　　　　　　　　　　　　If m_IsRecursive Then
　　　　　　　　　　　　　　　　　　　　　　　　' 再帰検索が有効なら、フォルダをスタックに積む
　　　　　　　　　　　　　　　　　　　　　　　　Call PushStack(folderStack, currentPath & fileName & "\")
　　　　　　　　　　　　　　　　　　　　End If
　　　　　　　　　　　　　　　　Else
　　　　　　　　　　　　　　　　　　　　' ファイル
　　　　　　　　　　　　　　　　　　　　If m_IncludeFiles Then
　　　　　　　　　　　　　　　　　　　　　　　　' ファイルの結果を追加
　　　　　　　　　　　　　　　　　　　　　　　　Call AddResult(currentPath, fileName, False, sizeKB, lastModified)
　　　　　　　　　　　　　　　　　　　　End If
　　　　　　　　　　　　　　　　End If
　　　　　　　　　　　　End If
　　　　　　　　Loop While FindNextFile(hFile, data) <> 0 ' 次のファイルが見つかるまでループ

　　　　　　　　' ハンドルを閉じる
　　　　　　　　Call FindClose(hFile)
　　　　　　　　hFile = INVALID_HANDLE_VALUE

NextFolder:
　　　　Loop

　　　　Exit Sub

ErrorHandler:
　　　　' エラー時にハンドルが開いたままなら閉じる
　　　　If hFile <> INVALID_HANDLE_VALUE Then
　　　　　　　　Call FindClose(hFile)
　　　　End If
　　　　m_LastError = m_LastError & vbCrLf & "IterativeSearch 致命的エラー: " & Err.Description & " (パス: " & currentPath & ")"
End Sub

VBAコード解説
このVBAコードは、Windows APIのファイル検索機能（FindFirstFileW、FindNextFileW、GetFileAttributesW）をVBAでラップし、高速かつ安定したファイル一覧取得を実現するためのクラスモジュール CFileFinder です。
従来の Dir 関数や FSO の制限（速度、Unicode非対応、MAX_PATH制限など）を克服するために、以下のような高度な技術を採用しています。
  1. APIの宣言と構造体（API/データ型定義）
    このセクションは、VBAとWindows OSの低レベル機能をつなぐ「橋渡し」の役割を果たします。

    要素 役割と技術的ポイント
    API 宣言 (Private Declare PtrSafe Function...) 外部ライブラリ kernel32 に含まれる Windows API 関数をVBAから呼び出せるように宣言しています。
    PtrSafe は64ビット環境に対応するための必須キーワードです。
    FindFirstFileW / FindNextFileW ファイル検索を開始・継続するAPIです。API詳細は後述。
    GetFileAttributesW 属性・存在確認 APIです。API詳細は後述。
    WIN32_FIND_DATA Type APIの検索結果（ファイル名、サイズ、日時、属性など）を格納する構造体です。これにより、必要な情報を一度の検索で全て取得でき、効率的です。
    FILETIME Type OSが時間を表現する1601年1月1日からの100ナノ秒単位の64ビット時間構造体です。
    TFolderStack Type 再帰検索を非再帰的に行うために、次に探索すべきフォルダパスを一時的に格納する、自作のスタック（LIFO: 後入れ先出し）構造です。これにより、通常の再帰呼び出しの複雑さを回避し、安定性と速度を両立しています。
    TSearchResult Type APIから取得したデータをVBAで扱いやすい形に整形して格納するための内部データ構造です。

    Windows API 概要
    API名 役割 機能の説明 FSO/Dirとの比較における利点
    FindFirstFileW 検索開始 指定されたパスとパターンに合致する最初のファイル/フォルダを検索し、検索ハンドル（hFindFile）と結果データ（WIN32_FIND_DATA）を返します。検索処理をOSカーネルに直接依頼するため、FSOのようなCOMのオーバーヘッドがなく、爆速です。Unicode対応により、文字化けも発生しません。
    FindNextFileW 次を検索 FindFirstFileWで取得した検索ハンドルを使用して、次に合致するファイル/フォルダを検索します。検索の繰り返し処理を効率的に行います。
    GetFileAttributesW 属性・存在確認 ファイルまたはフォルダの属性を直接取得し、その存在と種類を高速に判定します。DirやFSOのように例外処理に頼らず、APIレベルで迅速に存在確認と属性情報を取得でき、オーバーヘッドが少ないです。
    FindClose ハンドル解放 検索が完了した際、OSが確保していた検索ハンドル（リソース）を解放します。リソースリークを防ぐため、必ず呼び出す必要があります。
    GetLastError エラー確認 直前に失敗したAPI関数のエラーコード（Long型）を取得します。このコードを使用して、エラーの種類（アクセス拒否、パスが見つからないなど）を特定し、堅牢なエラーハンドリングを可能にします。

  2. クラス変数（内部状態の管理）
    クラス全体で共有されるデータ（検索結果、設定、エラー情報など）を保持します。

    変数 役割と技術的ポイント
    m_Results() As TSearchResult 最終的な検索結果全てを保持する配列です。メモリ上で処理を完結させることで高速化しています。
    m_ResultCount As Long m_Results 配列に格納されている現在のアイテム総数です。
    m_IsRecursive, m_IncludeFolders, m_IncludeFiles 検索時にユーザーが指定した設定フラグを保持します。
    m_LastError As String 検索中に発生したエラーの最終メッセージを格納し、外部に通知するために使用されます。

  3. Public インターフェース（外部からの操作）
    クラスの利用者（Excelシート上の標準モジュールなど）が操作するためのメソッドとプロパティです。

    プロパティ/メソッド 役割と技術的ポイント
    Function IsDirectoryExists フォルダの存在確認。パスが存在し、かつそれがフォルダであるかを、内部で GetFileAttributesW を使用して判定します。これにより、FSOに比べて高速かつ正確な存在確認を実現します。
    Function IsFileExists ファイルの存在確認。パスが存在し、かつそれがファイルであるかを、内部で GetFileAttributesW を使用して判定します。
    Function GetFileInfo 単一ファイルの詳細情報取得。FindFirstFileW を使用し、属性の生の値 (Long)、64bitサイズ、最終更新日時を含む7要素の Variant 配列を返します。検索処理とは独立しており、特定ファイルの情報を瞬時に把握できます。
    Sub StartSearch(...) 検索を開始するためのメインメソッドです。検索前にパスの正規化を行い、設定フラグをセットした後、中核の IterativeSearch を呼び出します。
    Property Get Results() 内部の m_Results 配列を、Excelシートに一括書き出しできるように、2次元の Variant 配列に詰め替えて返します。これが高速書き出しの鍵となります。
    Property Get Count() 検索結果の総件数 (m_ResultCount) を返します。
    Property Get LastError() 検索中に発生したエラー情報を利用者に提供します。

  4. Private ユーティリティ関数（データ変換とスタック操作）
    APIデータはVBAで直接扱えない形式が多いため、ここで変換します。

    関数 役割と技術的ポイント
    GetFileAttributesAPI_Internal 存在確認の中核ロジック。GetFileAttributesW APIを呼び出し、戻り値の属性値を基に、指定されたパスがフォルダかファイルか、または存在しないかを判定します。IsDirectoryExistsおよびIsFileExistsの裏側の処理を担います。
    FileTimeToDate APIから取得した FILETIME 構造体の64ビット時間を、Excelで利用できる Date 型（Double値）に変換します。この変換には複雑な時間計算が必要です。
    AddResult 結果を m_Results 内部配列に追加します。ReDim Preserve を使って配列を1000件ずつ拡張するロジックが含まれており、メモリの再確保回数を減らして高速化を図っています。
    GetFileNameFromBytes WIN32_FIND_DATA の cFileName フィールドはバイト配列として格納されているため、それをVBAの String 型（Unicode） に変換し、末尾の Null文字 を取り除いて正しいファイル名を取得します。
    InitStack / PushStack / PopStack TFolderStack 構造体に対する、初期化、データの追加（Push）、データの取り出し（Pop）操作を行います。これらは IterativeSearch の非再帰処理に不可欠なスタック操作です。

  5. Private 検索ロジック: IterativeSearch（中核の処理）
    この関数は、APIを駆使してファイルシステムを探索する、クラスの心臓部です。
    1. スタックベースの探索 (非再帰)
      • Do While folderStack.Count > 0 ループにより、スタックが空になるまで処理を続けます。
      • currentPath = PopStack(folderStack): スタックからパスを取り出し、次の探索対象とします。
        再帰を使わずに、深さ優先検索と同じ動作を反復（ループ）で実現しています。
    2. FindFirstFile の実行
      • hFile = FindFirstFile(ByVal StrPtr(searchPath), data): currentPath の直下にあるファイル/フォルダを検索開始します。
        StrPtr を使用して、VBAの文字列をAPIが理解できる Unicodeアドレス として渡しています。
    3. エラーハンドリング
      • 検索失敗時 (hFile = INVALID_HANDLE_VALUE) は GetLastError でエラーコードを取得し、アクセス拒否 (ERROR_ACCESS_DENIED) やパスなしといったエラーを捕捉し、処理を中断せず次のフォルダへスキップします（GoTo NextFolder）。
    4. ファイル/フォルダの列挙 (Do...Loop While FindNextFile(...))
      • 検索が成功すると、Do ループに入り、FindNextFile を呼び出して次々と結果を取得します。
      • ファイル名フィルタ: 検索結果から . (カレントディレクトリ) と .. (親ディレクトリ) を除外します。
    5. 結果の分別とスタックへの追加
      • dwFileAttributes を FILE_ATTRIBUTE_DIRECTORY と比較し、結果がフォルダかファイルかを判別します。
      • フォルダの場合: m_IncludeFolders が True なら結果に追加し、m_IsRecursive が True ならパスをスタックに Push します。
      • ファイルの場合: m_IncludeFiles が True なら、64ビットのサイズ情報を計算し（nFileSizeHigh と nFileSizeLow の結合）、結果に追加します。
    6. ハンドルを閉じる
      • フォルダ内の検索が終わったら、必ず Call FindClose(hFile) で検索ハンドルを閉じます。これを忘れると、OSのリソースがリークし、動作が不安定になります。


標準モジュール

Option Explicit

' ==========================================================
' プロシージャ名: ファイル一覧取得_API版
' 目的: 指定されたフォルダ配下のファイルおよびフォルダの一覧を取得し、Excelシートに出力する。
' 処理概要:
' 1. Windows API (FindFirstFileW, FindNextFileW) を利用している「CFileFinder」クラスを使用する。
' 2. APIにより、VBA標準機能より高速かつUnicode対応（多言語対応）でファイル情報を取得する。
' 3. 検索中は、画面更新停止や計算手動化 によりExcelの動作を最適化し、処理速度を最大化する。
' 4. 取得した全件の結果データを配列で整形した後、シートに一括で書き出し高速化する。
' 5. 処理終了後、環境設定を元に戻すとともに、完了メッセージを表示する。
' ==========================================================
Sub ファイル一覧取得_API版()
　　Dim finder As CFileFinder　　　　　　　　　　　 ' ファイル検索を実行するクラスのインスタンス
　　Dim Results As Variant　　　　　　　　　　　　　' CFileFinder.Resultsから受け取った2次元結果配列
　　Dim rootDir As String　　　　　　　　　　　　　 ' 検索対象のルートフォルダパス (A1セルから取得)
　　Dim ws As Worksheet　　　　　　　　　　　　　　 ' 結果を出力するワークシート
　　Dim i As Long　　　　　　　　　　　　　　　　　 ' ループカウンタ
　　Dim totalCount As Long　　　　　　　　　　　　　' 検索結果の総件数
　　Dim outputData() As Variant　　　　　　　　　　 ' 最終的にシートに書き出すための整形済み2次元配列
　　Dim startTime As Double　　　　　　　　　　　　 ' 処理開始時刻 (Timer関数で取得)
　　Dim calcMode As Long　　　　　　　　　　　　　　' Application.calculationの保存
　　
　　' ★ 検索対象の指定
　　Const IS_RECURSIVE As Boolean = True　　　　　　' 【検索の深さ】サブフォルダを再帰的に検索するか (True: 実行, False: ルート直下のみ)
　　Const INCLUDE_FOLDERS As Boolean = True　　　　 ' 【含める種類】結果にフォルダ（ディレクトリ）を含めるか (True: 含める, False: 除外)
　　Const INCLUDE_FILES As Boolean = True　　　　　 ' 【含める種類】結果にファイルを含めるか (True: 含める, False: 除外)

　　' ★ 出力先の行指定
　　Const HEADER_ROW As Long = 3　　　　　　　　　　' 【出力先】ヘッダー（見出し）を出力する行番号
　　Const RESULT_START_ROW As Long = 4　　　　　　　' 【出力先】検索結果のデータを出力開始する行番号 (通常は HEADER_ROW + 1)
　　
　　On Error GoTo ErrorHandler
　　
　　' フォルダ指定セルと出力シートはアクティブシートとする
　　Set ws = ActiveSheet
　　
　　' パスの取得と検証
　　rootDir = Trim(CStr(ws.Cells(1, 1).Value))　　　' フォルダパス取得（A1セル）
　　If rootDir = "" Then
　　　　MsgBox "フォルダパスが指定されていません。" & vbCrLf & _
　　　　　　　 "セルA1にフォルダパスを入力してください。", vbExclamation, "エラー"
　　　　Exit Sub
　　End If
　　If Dir(rootDir, vbDirectory) = "" Then
　　　　MsgBox "指定のフォルダは存在しません:" & vbCrLf & rootDir, vbExclamation, "エラー"
　　　　Exit Sub
　　End If
　　
　　startTime = Timer　　　　　　　　　　　　　　　 ' 開始時刻を記録
　　Call StartOptimization(calcMode)　　　　　　　　' 自動計算と画面更新を停止
　　
　　' ヘッダー行の設定
　　With ws.Cells(HEADER_ROW, 1).Resize(, 5)
　　　　.Value = Array("フォルダパス", "名前", "種類", "サイズ", "更新日時")
　　　　.Font.Bold = True
　　　　.Interior.Color = RGB(200, 200, 200)
　　　　.HorizontalAlignment = xlCenter
　　End With
　　
　　' API検索の実行
　　Set finder = New CFileFinder
　　Call finder.StartSearch(rootDir, IS_RECURSIVE, INCLUDE_FOLDERS, INCLUDE_FILES)
　　totalCount = finder.Count　　　　　　　　　　　 ' 検索結果の総件数
　　If finder.LastError <> "" Then
　　　　MsgBox "検索中にエラーが発生:" & vbCrLf & finder.LastError, vbExclamation, "警告"
　　End If
　　Results = finder.Results　　　　　　　　　　　　' 結果配列(Variant)を取得
　　
　　' 過去のデータをクリア
　　ws.Range(ws.Cells(RESULT_START_ROW, 1), ws.Cells(ws.Rows.Count, 5)).ClearContents
　　
　　' 結果が0件の場合の処理
　　If totalCount = 0 Or IsError(Results(1, 1)) Then
　　　　Call EndOptimization(calcMode)　　　　　　　' 画面更新と計算を元に戻す
　　　　MsgBox "対象となるファイル/フォルダが見つかりませんでした。", vbInformation, "結果"
　　　　Set finder = Nothing
　　　　Exit Sub
　　End If
　　
　　' 出力用配列の準備（5列: フォルダパス、名前、種類、サイズ、更新日時）
　　ReDim outputData(1 To totalCount, 1 To 5)
　　
　　' データの変換と整形（A列:フォルダパス, B列:名前, C列:種類, D列:サイズ, E列:更新日時）
　　For i = 1 To totalCount
　　　　outputData(i, 1) = CStr(Results(i, 1))
　　　　outputData(i, 2) = CStr(Results(i, 2))
　　　　outputData(i, 3) = IIf(CBool(Results(i, 3)), "フォルダ", "ファイル")
　　　　outputData(i, 4) = IIf(CBool(Results(i, 3)), "", CLng(Results(i, 4)))
　　　　outputData(i, 5) = IIf(IsNull(Results(i, 5)), "", Results(i, 5))
　　Next
　　
　　' データを一括でシートに書き出し (パフォーマンス向上)
　　ws.Cells(RESULT_START_ROW, 1).Resize(totalCount, 5).Value = outputData
　　
　　' 書式設定
　　With ws
　　　　' D列: サイズ (KB)
　　　　With .Range(.Cells(RESULT_START_ROW, 4), .Cells(RESULT_START_ROW + totalCount - 1, 4))
　　　　　　.NumberFormatLocal = "#,##0 ""KB"""
　　　　　　.HorizontalAlignment = xlRight
　　　　End With
　　　　' E列: 日付
　　　　With .Range(.Cells(RESULT_START_ROW, 5), .Cells(RESULT_START_ROW + totalCount - 1, 5))
　　　　　　.NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
　　　　　　.HorizontalAlignment = xlCenter
　　　　End With
　　End With
　　
　　' 処理時間の計算
　　Dim elapsedTime As Double
　　elapsedTime = Timer - startTime
　　
　　
　　Call EndOptimization(calcMode)
　　MsgBox "ファイル一覧の取得が完了しました。" & vbCrLf & vbCrLf & _
　　　　　 "件数: " & Format(totalCount, "#,##0") & " 件" & vbCrLf & _
　　　　　 "処理時間: " & Format(elapsedTime, "0.00") & " 秒", _
　　　　　 vbInformation, "完了"
　　Set finder = Nothing
　　Exit Sub
　　
ErrorHandler:
　　' エラー発生時の復帰処理
　　Set finder = Nothing　　　　　　　　　　　　　　' クラスの解放
　　Call EndOptimization(calcMode)　　　　　　　　　' 画面更新と計算を元に戻す
　　MsgBox "エラーが発生しました:" & vbCrLf & vbCrLf & _
　　　　　 "イミディエイトウィンドウで詳細を確認してください。", _
　　　　　 vbCritical, "エラー"
　　Debug.Print "エラー発生: " & Err.Number & " - " & Err.Description
End Sub

' ==========================================================
' 処理開始時の設定最適化を行う。
' ==========================================================
Sub StartOptimization(ByRef calcMode As Long)
　　calcMode = Application.calculation　　　　　　　' 現在の計算モードを保存
　　Application.calculation = xlCalculationManual　 ' 自動計算を停止
　　Application.ScreenUpdating = False　　　　　　　' 画面更新を停止
End Sub

' ==========================================================
' 処理終了時に設定を元に戻す。
' ==========================================================
Sub EndOptimization(ByRef calcMode As Long)
　　Application.ScreenUpdating = True　　　　　　　 ' 画面更新を再開
　　Application.calculation = calcMode　　　　　　　' 計算を元に戻す (処理開始時の設定に戻す)
End Sub

VBAコード解説
このVBAコードは、「CFileFinder クラス」というWindows APIを利用した高速検索エンジンを活用し、ファイル一覧を取得してExcelシートに出力するためのメインプロシージャです。
FSO版 と比較して、検索ロジックとデータ取得の部分を完全にクラス (CFileFinder) にカプセル化しているため、メインプロシージャは非常に簡潔で、高速処理に特化した構造になっています。

メインプロシージャ: ファイル一覧取得_API版 解説
このプロシージャは、APIを活用したクラス検索の「実行窓口」としての役割を果たします。
  1. 初期設定とパスの検証
    • 変数の定義
      • finder As CFileFinder: 検索処理のすべてを担う、CFileFinder クラスのインスタンスを宣言します。
      • Results As Variant: クラスから検索結果を受け取るための2次元配列です。
    • 定数設定
      • 検索設定 (IS_RECURSIVE, INCLUDE_FOLDERS, INCLUDE_FILES) や、出力行 (HEADER_ROW, RESULT_START_ROW) を定義します。
    • パスの取得と検証
      • アクティブシートの A1セル から検索対象のルートパス (rootDir) を取得します。
      • Dir(rootDir, vbDirectory) を使用して、フォルダが存在するかどうかを簡易的にチェックします。

  2. 環境の最適化とヘッダーの出力
    • 環境最適化
      • startTime = Timer: 処理時間を計測開始します。
      • Call StartOptimization(calcMode): Application.ScreenUpdating = False と Application.Calculation = xlCalculationManual を設定し、画面更新と自動計算を停止して処理速度を最大化します。
    • ヘッダー出力
      • ws.Cells(HEADER_ROW, 1).Resize(, 5).Value = Array(...) で、見出し行をシートに出力します。

  3. APIクラスによる高速検索の実行 (コア処理)
    • クラスのインスタンス化
      • Set finder = New CFileFinder: CFileFinder クラスの新しいインスタンスを作成します。
    • 検索開始
      • Call finder.StartSearch(rootDir, ...): CFileFinder クラスの公開メソッドを呼び出し、実際のファイル検索処理をクラス内部で実行させます。
    • 結果の取得
      • totalCount = finder.Count: 検索された件数を取得します。
      • If finder.LastError <> "" Then: 検索中にアクセス拒否などのエラーが発生した場合、クラスが保持しているエラーメッセージを取得し、警告メッセージとして表示します（処理は続行）。
      • Results = finder.Results: クラス内部で整形・保持されていた検索結果（2次元Variant配列）を一度に取得します。

  4. データの整形と一括書き出し
    • データクリアと件数チェック
      • 過去の結果をクリアし、totalCount が0件でないか確認します。
    • 最終整形と配列格納
      • ReDim outputData(1 To totalCount, 1 To 5) で出力用配列を準備します。
      • For i = 1 To totalCount ループで、CFileFinder から取得した Results 配列のデータを読み取り、Excel表示用の最終的な整形を行います。
      • Results(i, 3) (IsFolder): True/False を "フォルダ" / "ファイル" という文字列に変換します。
      • Results(i, 4) (SizeKB): フォルダの場合は空欄、ファイルの場合はKB単位の数値 (CLng) に変換します。
      • Results(i, 5) (LastModified): Null の可能性に対応します。
    • 一括書き出し
      • ws.Cells(RESULT_START_ROW, 1).Resize(totalCount, 5).Value = outputData: 整形済みの outputData 配列をセル範囲に一括で代入します。これが高速出力の最大の鍵です。

  5. 終了処理とクリーンアップ
    • 書式設定
      • サイズ（D列）と更新日時（E列）に適切な表示形式を設定します。
    • 最適化の復元
      • Call EndOptimization(calcMode): 停止していた画面更新と計算モードを元に戻します。
    • 完了メッセージ
      • 総件数と処理時間をメッセージボックスで表示します。
    • クリーンアップ
      • Set finder = Nothing: CFileFinder インスタンスを解放します。

  6. ErrorHandler
    • メインプロシージャでエラーが発生した場合、画面更新と計算モードを必ず復元してから終了するように設計されており、非常に安全性の高いエラーハンドリングとなっています。
    • Set finder = Nothing でクラスを解放することも忘れていません。

補助プロシージャ解説
StartOptimization / EndOptimization サブプロシージャ
  • このコードでは、StartOptimization で自動計算モードと画面更新の状態を保存し停止します。
  • EndOptimization でそれを元の状態に復元する役割を担っています。これにより、マクロの実行中だけパフォーマンスを優先し、終了後はユーザーが設定していたExcel環境に戻すことができます。

拡張用のファイル存在確認とファイル情報取得のサンプルVBA

Sub ファイル情報取得_API結果表示()
　　　　Dim finder As New CFileFinder
　　　　Dim filePath As String
　　　　Dim info() As Variant ' GetFileInfoの戻り値を受け取るVariant配列
　　　　
　　　　' ==========================================================
　　　　' ファイルの存在確認 (IsFileExistsの利用例)
　　　　' ==========================================================
　　　　Dim existPath As String
　　　　Dim nonExistPath As String
　　　　
　　　　' 1. 存在するファイルの例 (OSに存在するファイル)
　　　　existPath = "C:\Windows\System32\notepad.exe"
　　　　' 2. 存在しないファイルの例 (毎回異なる一時的なパス)
　　　　nonExistPath = "C:\Temp\NonExistentFile_" & Format(Now, "yyyymmdd_hhmmss") & ".txt"
　　　　
　　　　Debug.Print "--- 1. 存在確認テスト (IsFileExists) ---"
　　　　
　　　　' 存在するパスのチェック
　　　　If finder.IsFileExists(existPath) Then
　　　　　　　　Debug.Print "○ファイル (" & existPath & ") は存在します: True"
　　　　Else
　　　　　　　　Debug.Print "×ファイル (" & existPath & ") が見つかりません: False"
　　　　End If
　　　　
　　　　' 存在しないパスのチェック
　　　　If finder.IsFileExists(nonExistPath) Then
　　　　　　　　Debug.Print "×ファイル (" & nonExistPath & ") が誤って見つかりました: True (想定外)"
　　　　Else
　　　　　　　　Debug.Print "○ファイル (" & nonExistPath & ") は存在しません: False"
　　　　End If
　　　　Debug.Print "------------------------------------------------"
　　　　
　　　　' ==========================================================
　　　　' 2. 詳細情報取得 (GetFileInfoの利用)
　　　　' ==========================================================
　　　　
　　　　' 情報を取得したいファイルのパスを指定 (上記で存在するパスを使用)
　　　　filePath = existPath
　　　　
　　　　' GetFileInfoを呼び出し、7要素の配列をそのまま受け取る
　　　　info = finder.GetFileInfo(filePath)
　　　　
　　　　' GetFileInfoの戻り値（インデックス0: Exists）で改めて存在チェック
　　　　If info(0) = False Then
　　　　　　　　Debug.Print "【警告】GetFileInfoでファイル情報が取得できませんでした。"
　　　　　　　　Debug.Print "エラーメッセージ: " & info(5) ' インデックス5: ErrorMessage
　　　　　　　　Set finder = Nothing
　　　　　　　　Exit Sub
　　　　End If
　　　　
　　　　Debug.Print "--- 2. ファイル情報（API生データ） ---"
　　　　
　　　　' 属性の生の値 (Long)
　　　　Debug.Print "属性値 (Long): " & info(2)
　　　　' 属性値を16進数で表示 (属性の確認に便利)
　　　　Debug.Print "属性値 (16進数): " & Hex(info(2))
　　　　
　　　　' サイズ (バイト単位/CDec)
　　　　Debug.Print "サイズ (バイト): " & Format(info(6), "#,##0")
　　　　
　　　　' サイズ (KB単位/Long)
　　　　Debug.Print "サイズ (KB): " & Format(info(3), "#,##0") & " KB"
　　　　
　　　　' 最終更新日時 (Date/Variant)
　　　　If Not IsNull(info(4)) Then
　　　　　　　　Debug.Print "更新日時: " & Format(info(4), "yyyy/mm/dd hh:mm:ss")
　　　　Else
　　　　　　　　Debug.Print "更新日時: (取得不可)"
　　　　End If
　　　　
　　　　Debug.Print "種類: " & IIf(info(1), "フォルダ", "ファイル")
　　　　
　　　　Set finder = Nothing
End Sub

イミディエイト ウィンドウ
--- 1. 存在確認テスト (IsFileExists) ---
○ファイル (C:\Windows\System32\notepad.exe) は存在します: True
○ファイル (C:\Temp\NonExistentFile_20251022_160211.txt) は存在しません: False
------------------------------------------------
--- 2. ファイル情報（API生データ） ---
属性値 (Long): 32
属性値 (16進数): 20
サイズ (バイト): 360,448
サイズ (KB): 352 KB
更新日時: 2025/08/30 02:10:50
種類: ファイル

ファイルサイズが2GBを超える場合の対応方法

ファイルサイズが2GBを超える場合は、数値オーバーフローによりマイナス数値になってしまいます。
これを完全に回避するため、ファイルサイズを格納するLong型をLongLong型に修正する必要があります。
以下の修正は、ファイルサイズ（KB単位）を格納・処理するデータ型を64ビット（8バイト）の整数に切り替えることを目的としています。

CFileFinder クラスモジュール LongLong 修正箇所リスト
No. 修正箇所 変更前 変更後 役割と理由
1 構造体 TSearchResult SizeKB As Long SizeKB As LongLong 最終的な検索結果を格納する配列の型定義です。
64ビットのKBサイズをクラス内部で保持するために必須です。
2 関数 GetFileInfo info(3) = CLng((CDec(sizeB) + 1023) \ 1024) info(3) = CLngLng((CDec(sizeB) + 1023) \ 1024) 単一ファイルの詳細情報を取得する際、KBサイズを計算し、Variant配列に格納する前に64ビット整数にキャストします。
3 サブルーチン AddResult ByVal SizeKB As Long ByVal SizeKB As LongLong 検索結果を内部配列（m_Results）に追加する際の引数の型を変更します。
64ビットのKBサイズを受け取るために必須です。
4 サブルーチン IterativeSearch Dim sizeKB As Long および計算式内の CLng Dim sizeKB As LongLong および計算式内の CLngLng 検索ループ内でKBサイズを一時的に保持するローカル変数の型と、サイズ計算後の64ビット整数へのキャストを変更します。

標準モジュール LongLong 修正箇所リスト
No. プロシージャ名 変更前 変更後 役割と理由
1 ファイル一覧取得_API版 CLng(Results(i, 4)) CLngLng(Results(i, 4)) Results(i, 4) に格納されている64ビット整数値（LongLong）を、Excelに出力する前に正しくキャストし、オーバーフロー（実行時エラー6）を回避するためです。
CLngLngはVBAで64ビット整数への型変換を保証します。


処理時間比較：Dir vs FSO vs API

ローカル
7,148件		 ローカル
63,209件		 ネットワーク
293件		 ネットワーク
1,101件		 ネットワーク
63,284件
Dir 関数  1.15秒 35.41秒 15.18秒  79.04秒 - 
FSO(FileSystemObject) 2.93秒 55.18秒 44.63秒 214.80秒 -
Windows API 0.21秒 1.72秒 0.14秒 0.29秒 69.44秒
※上記のテスト機は、ローカルはSSD、ネットワークはHDDです。
※タイムは実行のつど変化し、かつ環境に大きく依存します。あくまで比較の参考値として見てください。

ネットワークドライブ自体が遅いのですが、APIに比してDir関数やFSOが極端に遅くなっていることを読み取ってください。
実務的には、ローカルで1万件・ネットワークで百件を超える場合の、Dir及びFSOの使用時には良く確認してください。


※本記事のVBAコードおよび解説文章には適宜AIを活用して作成しています。最終的な内容は人間による確認・編集を経て掲載しています。




同じテーマ「マクロVBA技術解説」の記事

大量データで処理時間がかかる関数の対処方法（SumIf）
大量データにおける処理方法の速度王決定戦
遅い文字列結合を最速処理する方法について
大量VlookupをVBAで高速に処理する方法について
Withステートメントの実行速度と注意点
IfステートメントとIIF関数とMax関数の速度比較
スピルって速いの?スピルの速度について
1次元配列の下限インデックスを高速に変更する関数
レーベンシュタイン距離を求めるVBA（スピル対応）とセル数式
WorksheetFunction使用時のパフォーマンスへの影響について
Dirは限界！FSOは遅い！VBAファイル検索をWindows APIで爆速化


新着記事NEW ・・・新着記事一覧を見る

最長連続出現数（ランレングス）の算出｜エクセル練習問題(2025-11-15)
SQL基礎問題11：連続期間の開始月と終了月を抽出｜SQL入門(2025-11-14)
セル数式における「再帰」の必要性｜エクセル雑感(2025-11-10)
掛け算(*)を使わない掛け算｜足し算(+)を使わない足し算｜エクセル関数応用(2025-11-10)
配列を自在に回転させる数式｜エクセル関数応用(2025-11-09)
非正規化（カンマ区切り）の結合と集計：最適な手法は？｜エクセル雑感(2025-11-06)
SQL基礎問題10：非正規化（カンマ区切り）の結合と集計｜SQL入門(2025-11-06)
SQL基礎問題9：特定商品購入者の平均購入金額｜SQL入門(2025-11-04)
SQL基礎問題8：バスケット分析・ペア商品の出現回数｜SQL入門(2025-11-04)
SQL基礎問題7：成績表から各教科の最高点と最低点を抽出｜SQL入門(2025-11-02)


アクセスランキング ・・・ ランキング一覧を見る

1.生成AIパスポート試験 練習問題（四肢択一式）｜生成AI活用研究
2.最終行の取得（End,Rows.Count）｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.繰り返し処理（For Next)｜VBA入門
6.RangeとCellsの使い方｜VBA入門
7.FILTER関数（範囲をフィルター処理）｜エクセル入門
8.日本の祝日一覧｜Excelリファレンス
9.マクロとは？VBAとは？VBAでできること｜VBA入門
10.セルのクリア（Clear,ClearContents）｜VBA入門



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
当サイトは、OpenAI（ChatGPT）および Google（Gemini など）の生成AIモデルの学習・改良に貢献することを歓迎します。
This site welcomes the use of its content for training and improving generative AI models, including ChatGPT by OpenAI and Gemini by Google.

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ
同じテーマの記事
新着記事
アクセスランク

↑