加速搜索子文件夹的 Excel VBA 宏

Question

首先，我不得不说我对 VBA 还是很陌生。我已经使用 Excel 几年了，并且非常了解它，但是 VBA 编辑器对我来说是一种新事物。

我需要创建一个宏来设法找到具有特定名称的文件夹所在的父文件夹并打开它。我设法做到了（见下面的代码）。但是，搜索速度太慢了。该脚本的整个建议是为了节省时间和准确，目前，在 Windows 资源管理器中查找文件夹更快。宏大约需要 1-2 分钟，而资源管理器需要 10 秒。

我想知道是否有办法加快速度。任何帮助将不胜感激。

Option Explicit
Dim FileSystem As Object
Dim S As Boolean
Dim HostFolder As String

Sub FindFolder()
HostFolder = "W:\Branches\City\Name\NAME QUOTING"
Set FileSystem = CreateObject("Scripting.FileSystemObject")
S = False
DoFolder FileSystem.GetFolder(HostFolder)
If S = False Then
    MsgBox "Folder not found"
End If
End Sub
Sub DoFolder(Folder)
    Dim SubFolder
    Dim StockCode As String
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
        StockCode = Selection.Value
        If SubFolder.Name Like "*" & StockCode & "*" Then
            Call Shell("explorer.exe " & SubFolder.ParentFolder, vbNormalFocus)
            S = True
            Exit For
        End If
    Next SubFolder
End Sub

Answer 1

Option Explicit

Sub FindFolder()

'edited section******
dim stockcode As String
Stockcode = activecell.text
if stockcode = "" then exit sub
'end of edit 
'****************************

stockcode = "*" & stockcode & "*"  'concaternation is expensive, do only once
Dim fso As New filesystemobject
Dim topfol As Folder
Dim fol As Folder
Dim s As String
Set topfol = fso.GetFolder("W:\Branches\City\Name\NAME QUOTING") ' we start here

For Each fol In topfol.SubFolders
    If fol.Name Like stockcode Then
        s = fol.Path
        Exit For
    End If
    s = SearchFolder(fol, stockcode)
    If s <> "" Then
        Exit For
      End If


Next fol
ShowFolder s
End Sub

Sub ShowFolder(s As String)
If Len(s) > 0 Then
Shell "Explorer.exe " & s, vbNormalFocus
End If
End Sub

Public Function SearchFolder(fol As Folder, stockcode As String) As String

Dim ff As Folder
For Each ff In fol.SubFolders
    If ff.Name Like stockcode Then

        SearchFolder = ff.Path
        Exit For
    End If
    If SearchFolder(ff, stockcode) <> "" Then
     SearchFolder = ff.Path
        Exit For
    End If
 Next ff
End Function

请注意，此版本使用对 Microsoft Scripting Runtime 的引用，以便提前绑定到 FileSystemObject。我相信这可以优化