Excel VBA:搜索目录

时间:2017-10-09 11:20:08

标签: excel vba excel-vba

在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

1 个答案:

答案 0 :(得分:2)

我认为你低估了层次结构的大小。将您的代码更改为此代码,以查看您正在递归的文件夹数量。

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

运行代码时,代码末尾的数字是多少?