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

首先，我必须说我对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

选项显式
子FindFolder（）
"编辑部分,******
将代码设置为字符串
Stockcode=activecell.text
如果stockcode=“”，则退出子系统
'编辑结束
'****************************
stockcode=“*”&stockcode&“*”'合并成本很高，只能执行一次
将fso设置为新的filesystemobject
Dim topfol As文件夹
Dim fol As文件夹
像线一样变暗
设置topfol=fso.GetFolder（“W:\branchs\City\Name\Name QUOTING”）“我们从这里开始
对于topfol.SubFolders中的每个文件夹
如果fol.Name像stockcode那么
s=以下路径
退出
如果结束
s=搜索文件夹（fol，股票代码）
如果是“”，那么
退出
如果结束
下一步
展示文件夹
端接头
子ShowFolder（作为字符串）
如果Len（s）>0，则
Shell“Explorer.exe”&s，vbNormalFocus
如果结束
端接头
公共函数SearchFolder（fol作为文件夹，stockcode作为字符串）作为字符串
Dim ff As文件夹
对于fol.子文件夹中的每个ff
如果ff.名称像股票代码那么
SearchFolder=ff.Path
退出
如果结束
如果搜索文件夹（ff，股票代码）“，则
SearchFolder=ff.Path
退出
如果结束
下一个ff
端函数

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

选项
子FindFolder（）
"编辑部分,******
将代码设置为字符串
Stockcode=activecell.text
如果stockcode=“”，则退出子系统
'编辑结束
'****************************
stockcode=“*”&stockcode&“*”'合并成本很高，只能执行一次
将fso设置为新的filesystemobject
Dim topfol As文件夹
Dim fol As文件夹
像线一样变暗
设置topfol=fso.GetFolder（“W:\branchs\City\Name\Name QUOTING”）“我们从这里开始
对于topfol.SubFolders中的每个文件夹
如果fol.Name像stockcode那么
s=以下路径
退出
如果结束
s=搜索文件夹（fol，股票代码）
如果是“”，那么
退出
如果结束
下一步
展示文件夹
端接头
子ShowFolder（作为字符串）
如果Len（s）>0，则
Shell“Explorer.exe”&s，vbNormalFocus
如果结束
端接头
公共函数SearchFolder（fol作为文件夹，stockcode作为字符串）作为字符串
Dim ff As文件夹
对于fol.子文件夹中的每个ff
如果ff.名称像股票代码那么
SearchFolder=ff.Path
退出
如果结束
如果搜索文件夹（ff，股票代码）“，则
SearchFolder=ff.Path
退出
如果结束
下一个ff
端函数

---

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

当您找到文件时，您需要退出整个递归。可能将

Exit For

更改为

Exit Sub

，并在

DoFolder子文件夹

后添加一行，如果找到文件，则退出Sub

，则需要退出整个递归。可能会将

Exit For

更改为

Exit Sub

，并在

DoFolder子文件夹

后添加一行，如果是，则退出Sub

非常感谢，烦扰的爸爸，但我恐怕因为某种原因无法运行它。我不知道我是否做错了什么，但当我点击“运行”按钮时，宏框显示为空。啊-你将股票代码作为所选单元格传递。坚持右-请参见上面的编辑，因为您特别提到了早期绑定，我要补充的是，早期绑定确实提供了性能优势，在本例中是一个值得注意的优势。对于一次性案例（比如从模板创建新的Outlook邮件），其好处往往可以忽略不计，但对于文件系统，有时是字典，它在我的经验中有一些明显的效果。非常感谢你们的帮助，伙计们。我已经试过了，尽管它允许我运行它，但它给了我一个错误，上面写着“用户定义的类型不是定义者”，并且它不起作用。Excel在下面突出显示：公用函数SearchFolder（fol作为文件夹，stockcode作为字符串）作为字符串您是否引用了Microsoft脚本运行时？这是这条信息最常见的原因。在VB编辑器中，转到工具、引用，并确保运行时被勾选。对此，爸爸很生气，但我担心由于某种原因我无法运行它。我不知道我是否做错了什么，但当我点击“运行”按钮时，宏框显示为空。啊-你将股票代码作为所选单元格传递。坚持右-请参见上面的编辑，因为您特别提到了早期绑定，我要补充的是，早期绑定确实提供了性能优势，在本例中是一个值得注意的优势。对于一次性案例（比如从模板创建新的Outlook邮件），其好处往往可以忽略不计，但对于文件系统，有时是字典，它在我的经验中有一些明显的效果。非常感谢你们的帮助，伙计们。我已经试过了，尽管它允许我运行它，但它给了我一个错误，上面写着“用户定义的类型不是定义者”，并且它不起作用。Excel在下面突出显示：公用函数SearchFolder（fol作为文件夹，stockcode作为字符串）作为字符串您是否引用了Microsoft脚本运行时？这是这条信息最常见的原因。在VB编辑器中，转到工具、引用，并确保勾选了运行时

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