Excel VBA：ディレクトリを検索

Question

vbaでは、特定のディレクトリ名のディレクトリを検索したいと思います。理想的には、検索時間は速くなります（Windows検索と同様）。

さまざまなソースから、再帰的なサブプログラムを使ってスクリプトを作成することができました。スクリプトは機能しますが、階層が少し複雑になるとすぐに非常に遅くなります。

検索を高速化する手段はありますか？

Sub GetFolder(Folder As String, searchF As String, colFolder As Collection) 
Dim SubFolder, subF As New Collection, sf As String 
If Right(Folder, 1) <> "\" Then Folder = Folder & "\" 

If Dir(Folder & searchF, vbDirectory) <> "" Then colFolder.Add Folder & searchF & "\" 

sf = Dir(Folder, vbDirectory) 
Do While Len(sf) > 0 
    If sf <> "." And sf <> ".." Then 
     If (GetAttr(Folder & sf) And vbDirectory) <> 0 Then 
       subF.Add Folder & sf 
     End If 
    End If 
    sf = Dir() 
Loop 

For Each SubFolder In subF 
    GetFolder CStr(SubFolder), searchF, colFolder 
Next 
End Sub 

Answer 1

私はあなたが階層のサイズを過小評価していると思います。コードをこのフォルダに変更して、再帰しているフォルダの数を確認します。

Option Explicit 

Sub GetFolder(Folder As String, searchF As String, colFolder As Collection, ByRef counter As Long) 

    Dim SubFolder, subF As New Collection, sf As String 
    If Right(Folder, 1) <> "\" Then Folder = Folder & "\" 

    If Dir(Folder & searchF, vbDirectory) <> "" Then colFolder.Add Folder & searchF & "\" 

    sf = Dir(Folder, vbDirectory) 

    Do While Len(sf) > 0 
     If sf <> "." And sf <> ".." Then 
      If (GetAttr(Folder & sf) And vbDirectory) <> 0 Then 
       Debug.Print Folder & sf 
       counter = counter + 1 
       subF.Add Folder & sf 
      End If 
     End If 
     sf = Dir() 
    Loop 

    For Each SubFolder In subF 
     GetFolder CStr(SubFolder), searchF, colFolder, counter 
    Next 

End Sub 

Public Sub TestMe() 

    Dim newC  As New Collection 
    Dim colChecked As New Collection 
    Dim counter  As Long 

    GetFolder "C:\Users\<username>\Desktop\BA Tools", "v", newC, counter 
    Debug.Print counter 

End Sub 

実行時にコードの末尾に表示される番号は何ですか。