■Fso再帰|非再帰

#しばらくscrapネタ続きます.. :)

対象フォルダ配下サブフォルダ含めてファイルリストを取得したい、というニーズでよく使われるFileSystemObject再帰。
あまのじゃっきーな私はこの非再帰コードを書いてみた。

Option Explicit

Private Const cPath As String = "C:¥WORK¥" '対象フォルダパス
Private Const MX　　As Long = 100000　　　 '取得用配列サイズ大きめに
Private FSO　　　　 As Object　　　　　　　'FileSystemObject
Private fList()　　 As String　　　　　　　'ファイル名取得用配列
Private idx　　　　 As Long　　　　　　　　'配列Index
'-------------------------------------------------
Private Sub test() 'テストプロシージャ選択用
　　Dim t As Single
　　t = Timer

　　Call TestFsoLoop

　　Debug.Print idx & " files", Timer - t
End Sub
'-------------------------------------------------
Private Sub TestFsoRecur() '再帰版
　　Dim sPath As String
　　ReDim fList(1 To MX, 0)

　　sPath = cPath
　　idx = 0
　　Set FSO = CreateObject("scripting.filesystemobject")
　　Call FsoRecur(sPath)
　　Set FSO = Nothing
　　'Sheets.Add.Range("A1").Resize(idx).Value = fList
　　Erase fList
End Sub
Private Sub FsoRecur(sPath As String)
　　Dim x As Object

　　With FSO.GetFolder(sPath)
　　　　For Each x In .Files
　　　　　　idx = idx + 1
　　　　　　fList(idx, 0) = x.Path
　　　　Next
　　　　For Each x In .SubFolders
　　　　　　idx = idx + 1
　　　　　　fList(idx, 0) = x.Path
　　　　　　Call FsoRecur(x.Path)
　　　　Next
　　End With
End Sub
'-------------------------------------------------
Private Sub TestFsoLoop()　'非再帰版
　　Dim x　　 As Object
　　Dim sPath As String
　　Dim i　　 As Long
　　Dim j　　 As Long
　　Dim d(1 To MX) As Long 'サブフォルダidx記憶用
　　ReDim fList(1 To MX, 0)

　　sPath = cPath
　　idx = 0
　　Set FSO = CreateObject("scripting.filesystemobject")
　　Do
　　　　With FSO.GetFolder(sPath)
　　　　　　For Each x In .SubFolders
　　　　　　　　idx = idx + 1
　　　　　　　　i = i + 1
　　　　　　　　fList(idx, 0) = x.Path
　　　　　　　　d(i) = idx
　　　　　　Next
　　　　　　For Each x In .Files
　　　　　　　　idx = idx + 1
　　　　　　　　fList(idx, 0) = x.Path
　　　　　　Next
　　　　End With
　　　　j = j + 1
　　　　If j > i Then Exit Do
　　　　sPath = fList(d(j), 0)
　　Loop
　　Set FSO = Nothing
　　'Sheets.Add.Range("A1").Resize(idx).Value = fList
　　Erase fList
End Sub

結果。別に速さを求めたわけじゃないけど..一応。

[TestFsoRecur]
20000 files　　15.70313
20000 files　　15.71875
20000 files　　15.71875

[TestFsoLoop]
20000 files　　15.03125
20000 files　　15.03125
20000 files　　15.03125

C:\WORK配下のフォルダは最大10階層。
20,000ファイル＆フォルダでのテスト。