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

' ========================================================== ' プロシージャ名: ファイル一覧取得_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)

' 過去のデータをクリア 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

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

VBAコード解説 このVBAコードは、FSO (FileSystemObject) を利用して、指定したフォルダ内のファイルおよびサブフォルダの一覧を再帰的に取得し、その結果をExcelシートに出力するためのものです。特に、Dir関数が再帰処理（Functionが自分自身を呼び出す）に向かないという制約を、配列をスタック（キュー）として利用した「非再帰探索」という高度な手法で回避している点が特徴です。

メインプロシージャ: ファイル一覧取得_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) で環境を元に戻した後、処理時間と件数を表示して終了します。
- aryDir(): 検索すべきフォルダのパスを格納する配列です。
- i (インデックス): 既に処理が完了したフォルダを追跡するカウンターです。
- Do While i
- On Error Resume Next でアクセス権のないフォルダのエラーを回避し、処理が中断しないようにしています。
- 列挙
  - strName = Dir(currentFolder & "*", FILE_ATTR) で、指定属性（通常、隠し、システム、ディレクトリなど）を持つ全てのファイル・フォルダを列挙します。
  - Dir関数自体はサイズや日時を返さないため、ファイルであることが判明した後で、FileLen 関数（サイズ）とFileDateTime 関数（更新日時）を呼び出して情報を取得しています。
  - これらの関数呼び出し時もアクセスエラーが発生しやすいため、ここでも On Error Resume Next を適切に使用し、エラー発生時は値を空にして処理を継続するように設計されています。
  - AddTrailingBackslash 関数パス文字列 (targetPath) を受け取り、その末尾がバックスラッシュ (\) で終わっていない場合に、自動的にバックスラッシュを追加します。パスの連結時 (ParentFolder.Path & Name のような処理) に、バックスラッシュの有無を気にせず常に正しいフルパスを生成できるようにし、コードの可読性を高めます。
  - StartOptimization / EndOptimization サブプロシージャExcelのパフォーマンスを最大化するために、マクロ実行前後の環境設定を自動で行います。
    - StartOptimization現在の計算モードを calcMode に保存します。 Application.Calculation = xlCalculationManual で自動計算を停止します。 Application.ScreenUpdating = False で画面更新を停止します。
    - EndOptimizationScreenUpdating = True で画面更新を再開します。保存しておいた calcMode に戻し、計算モードを復元します。
    ファイル一覧取得：FSO(FileSystemObject) 版
    ' ========================================================== ' プロシージャ名: ファイル一覧取得_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)
    
    ' 過去のデータをクリア 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
    
    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
    
    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
    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: 実行時エラーが発生した場合の復旧処理とメッセージ表示を行います。
      - StartOptimization現在の計算モードを calcMode に保存します。 Application.Calculation = xlCalculationManual で自動計算を停止します。 Application.ScreenUpdating = False で画面更新を停止します。
      - EndOptimizationScreenUpdating = True で画面更新を再開します。保存しておいた calcMode に戻し、計算モードを復元します。
      ファイル一覧取得：Windows API (FindFirstFileW, FindNextFileW) 版クラスモジュール ' --- 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
      
      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)
      
      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
      ' --- 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 検索ロジック（反復関数） ---
      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 VBAコード解説
      要素役割と技術的ポイント 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型）を取得します。このコードを使用して、エラーの種類（アクセス拒否、パスが見つからないなど）を特定し、堅牢なエラーハンドリングを可能にします。変数役割と技術的ポイント m_Results() As TSearchResult 最終的な検索結果全てを保持する配列です。メモリ上で処理を完結させることで高速化しています。 m_ResultCount As Long m_Results 配列に格納されている現在のアイテム総数です。 m_IsRecursive, m_IncludeFolders, m_IncludeFiles 検索時にユーザーが指定した設定フラグを保持します。 m_LastError As String 検索中に発生したエラーの最終メッセージを格納し、外部に通知するために使用されます。プロパティ/メソッド役割と技術的ポイント 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() 検索中に発生したエラー情報を利用者に提供します。関数役割と技術的ポイント 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 の非再帰処理に不可欠なスタック操作です。
      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のリソースがリークし、動作が不安定になります。
      標準モジュール
      ' ========================================================== ' プロシージャ名: ファイル一覧取得_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
      VBAコード解説
      このVBAコードは、「CFileFinder クラス」というWindows APIを利用した高速検索エンジンを活用し、ファイル一覧を取得してExcelシートに出力するためのメインプロシージャです。 FSO版と比較して、検索ロジックとデータ取得の部分を完全にクラス (CFileFinder) にカプセル化しているため、メインプロシージャは非常に簡潔で、高速処理に特化した構造になっています。
      メインプロシージャ: ファイル一覧取得_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) を使用して、フォルダが存在するかどうかを簡易的にチェックします。
      - 環境最適化
        
        startTime = Timer: 処理時間を計測開始します。
        
        Call StartOptimization(calcMode): Application.ScreenUpdating = False と Application.Calculation = xlCalculationManual を設定し、画面更新と自動計算を停止して処理速度を最大化します。
        
        クラスのインスタンス化
        
        Set finder = New CFileFinder: CFileFinder クラスの新しいインスタンスを作成します。
        
        Call finder.StartSearch(rootDir, . ): CFileFinder クラスの公開メソッドを呼び出し、実際のファイル検索処理をクラス内部で実行させます。
        
        データクリアと件数チェック
        
        過去の結果をクリアし、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 の可能性に対応します。
        
        書式設定
        
        サイズ（D列）と更新日時（E列）に適切な表示形式を設定します。
        
        Call EndOptimization(calcMode): 停止していた画面更新と計算モードを元に戻します。
        
        総件数と処理時間をメッセージボックスで表示します。
        
        補助プロシージャ解説
        
        このコードでは、StartOptimization で自動計算モードと画面更新の状態を保存し停止します。
        
        EndOptimization でそれを元の状態に復元する役割を担っています。これにより、マクロの実行中だけパフォーマンスを優先し、終了後はユーザーが設定していたExcel環境に戻すことができます。
        拡張用のファイル存在確認とファイル情報取得のサンプルVBA
        ' 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 "------------------------------------------------"
        
        ' 情報を取得したいファイルのパスを指定 (上記で存在するパスを使用) 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), "フォルダ", "ファイル")
        イミディエイトウィンドウ --- 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です。 ※タイムは実行のつど変化し、かつ環境に大きく依存します。あくまで比較の参考値として見てください。 ※本記事のVBAコードおよび解説文章には適宜AIを活用して作成しています。最終的な内容は人間による確認・編集を経て掲載しています。同じテーマ「マクロVBA技術解説」の記事新着記事 NEW ・・・新着記事一覧を見るアクセスランキング・・・ランキング一覧を見る
        
        ホーム
        
        マクロVBA応用編
        
        マクロVBA技術解説
        
        Dirは限界！FSOは遅い！VBAファイル検索をWindows APIで爆速化
        
        このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
        記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。 This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.
        
        ホーム
        
        マクロVBA応用編
        
        マクロVBA技術解説
        
        Dirは限界！FSOは遅い！VBAファイル検索をWindows APIで爆速化
        
        📎📎📎📎📎📎📎📎📎📎