Ускорение макроса 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. Я уверен, что это может быть оптимизировано