ファイルの一覧取得処理(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