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

運行代碼時，在代碼末尾得到的數字是多少？