Excel
ExcelVBA

ファイル一覧を取得し、新しいシートに出力する

ファイルの一覧取得処理(fileutilクラス)は以下の記事のものを使わせてもらった。
VBAマクロでファイル一覧を再帰的に取得するFunctionプロシージャを作成してみた。

ファイル一覧を新シートに出力
Sub FileList2NewSheet()
    'ファイル一覧取得
    Dim targetpath As String: targetpath = InputBox("ファイル一覧を取得したいフォルダパスを入力してください。", "入力", "")
    Dim fu As fileutil: Set fu = New fileutil
    Dim result As Collection: Set result = fu.getFileListRecursive(targetpath).Files

    '新シート作成
    Sheets.Add

    'ヘッダ作成
    Range("A1:D1").Interior.Color = RGB(220, 120, 120)
    Range("A1:D1").Value = Array("フォルダ", "ファイル名", "日付", "サイズ")
    Range("A2").Select
    ActiveWindow.FreezePanes = True

    '結果出力
    Dim r: r = 2
    Dim objFiles As File
    For Each objFiles In result
        Dim p1: p1 = objFiles.ParentFolder 'フォルダ
        Dim p2: p2 = objFiles.Name 'ファイル名
        Dim p3: p3 = FileDateTime(objFiles) '日付
        Dim p4: p4 = Format(objFiles.Size / 1024, "#.0") 'サイズ
        Range(Cells(r, 1), Cells(r, 4)) = Array(p1, p2, p3, p4)
        r = r + 1
    Next

    '列幅調整
    Columns("A:D").EntireColumn.AutoFit
End Sub
fileutil
Option Explicit

Private m_fso As FileSystemObject
Private m_files As Collection

Property Get FSO() As FileSystemObject
    Set FSO = m_fso
End Property

Property Get Files() As Collection
    Set Files = m_files
End Property

' ファイル一覧を再帰的に取得する関数
' 引数: folder_path 取得する起点のフォルダ
' 引数: pattern 取得対象のパターン(正規表現)
Public Function getFileListRecursive(folder_path As String, Optional pattern As String = "") As fileutil
    ' ファイル一覧の結果格納用
    Dim file_list_tmp As Collection

    ' ループ用変数の宣言
    Dim folder As Variant
    Dim file_path As Variant
    Dim dir As Variant

    ' オブジェクトの初期化
    Set file_list_tmp = New Collection

    ' 現在ディレクトリ内の全ファイルの取得
    For Each file_path In FSO.GetFolder(folder_path).Files
        If file_path Like "*" & pattern & "*" Then
            DoEvents    ' フリーズ防止用
            Call Files.Add(file_path)
        End If
    Next

    ' サブディレクトリの再帰
    For Each dir In FSO.GetFolder(folder_path).SubFolders
        Call getFileListRecursive(dir.Path, pattern)
    Next


    Set getFileListRecursive = Me
End Function

' メンバ変数の初期化
Private Sub Class_Initialize()
    Set m_fso = New FileSystemObject
    Set m_files = New Collection
End Sub

' メンバ変数の解放
Private Sub Class_Terminate()
    Set m_fso = Nothing
    Set m_files = Nothing
End Sub