如何在文件夹和子文件夹中搜索excel工作簿，以在excel VBA中查找特定的文本字符串

我目前有一个巨大的文件夹，其中包含许多包含Excel工作簿的文件夹。我希望有一个用户输入请求一个数字字符串（例如：405599），搜索每个文件夹、子文件夹、工作簿、工作表，并提供该文件的链接或位置。这是当前的代码，但它似乎无法搜索第一个文档的第一行，然后崩溃

公共WS-As工作表 子SearchWKBooks子文件夹（可选Folderpath作为变量，可选Str作为变量） 将myfolder设置为字符串 黯然失色 将sht变暗为工作表 昏暗的灯光如同单身 将文件夹（）设置为字符串 Dim文件夹作为变体 重拨文件夹（0） 如果是missing（Folderpath），则 设置WS=Sheets.Add 使用Application.FileDialog（msoFileDialogFolderPicker） 显示 myfolder=.SelectedItems（1）和“\” 以 Str=Application.InputBox（提示：=“搜索字符串：”，标题：=“搜索文件夹中的所有工作簿”，类型：=2） 如果Str=”“，则退出Sub WS.Range（“A1”）=“搜索字符串：” WS.Range（“B1”）=Str WS.Range（“A2”）=“路径：” WS.Range（“B2”）=myfolder WS.Range（“A3”）=“Folderpath” WS.Range（“B3”）=“工作簿” WS.Range（“C3”）=“工作表” WS.Range（“D3”）=“单元地址” WS.Range（“E3”）=“链接” Folderpath=myfolder Value=Dir（myfolder，&H1F） 其他的 如果Right（Folderpath，2）=“\\”则 出口接头 如果结束 Value=Dir（文件夹路径和H1F） 如果结束 Do Until Value=“” 如果Value=“”或Value=“…”则 其他的 如果GetAttr（Folderpath&Value）=16，则 文件夹（UBound（Folders））=值 重拨保留文件夹（UBound（文件夹）+1） ElseIf（右（值，3）=“xls”或右（值，4）=“xlsx”或右（值，4）=“xlsm”）和左（值，1）“~”然后 出错时继续下一步 将wb设置为工作簿 设置wb=Workbooks.Open（文件名：=Folderpath&Value，密码：=“zzzzzzzz”） 错误转到0 '如果工作簿上有错误。打开，则wb为Nothing: 如果wb不算什么，那么 Lrow=WS.Range（“A”&Rows.Count）。End（xlUp）。Row+1 WS.Range（“A”&Lrow）.Value=Value WS.Range（“B”和Lrow）.Value=“受密码保护” 其他的 对于wb.工作表中的每个sht '展开工作表中的所有组 sht.解除保护 sht.Outline.ShowLevels行级别：=8，列级别：=8 设置c=sht.Cells.Find（Str，After:=sht.Cells（1，1），LookIn:=xlValues，LookAt:=xlother，SearchOrder:=xlByRows，SearchDirection:=xlNext） 如果不是，那么c什么都不是 firstAddress=c.地址 做 Lrow=WS.Range（“A”&Rows.Count）。End（xlUp）。Row+1 WS.Range（“A”&Lrow）.Value=Folderpath WS.Range（“B”和Lrow）.Value=Value WS.Range（“C”和Lrow）.Value=sht.Name WS.Range（“D”和Lrow）.Value=c.地址 WS.Hyperlinks.Add锚点：=WS.Range（“E”和Lrow），地址：=Folderpath和Value，子地址：=_ “&sht.Name&”“和”！”&c.地址，文本显示：=“链接” 设置c=sht.Cells.FindNext（之后：=c） 循环而不是c为Nothing，c.Address为firstAddress 如果结束 下一步 wb.关闭错误 如果结束 如果结束 如果结束 Value=Dir 环 对于文件夹中的每个文件夹 调用SearchWKBooks子文件夹（文件夹路径和文件夹&“\”，Str） 下一个文件夹 Cells.EntireColumn.AutoFit

---

End Sub这将改进错误处理程序，因为它的作用域不正确，因此可能会导致问题

我已将

Find

和

FindNext

更改为使用

After

参数，否则可能会得到一些意外的结果。Per（增加重点）：

After:=要搜索的单元格。这与从用户界面执行搜索时活动单元格的位置相对应。请注意，After必须是范围内的单个单元格。请记住，搜索开始于此单元格之后；在方法回绕到此单元格之前，不会搜索指定的单元格如果未指定此参数，则搜索将在区域左上角的单元格之后开始。

此外，我也不知道为什么在发生错误时，您会使用

a

进行偏移，而不仅仅是使用

LRow

计算。我也做出了改变

在下面我注意到的

”的行上放置一个断点，在这里断开并使用F8单步执行代码，然后使用F8逐行执行代码，以确认此方法工作正常。确认后，删除断点，就可以让代码运行到完成

Public WS As Worksheet
Sub SearchWKBooksSubFolders(Optional Folderpath As Variant, Optional Str As Variant)
Dim myfolder As String
Dim a As Single
Dim sht As Worksheet
Dim Lrow As Single
Dim Folders() As String
Dim Folder As Variant
ReDim Folders(0)
If IsMissing(Folderpath) Then
    Set WS = Sheets.Add
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        myfolder = .SelectedItems(1) & "\"
    End With
    Str = Application.InputBox(prompt:="Search string:", Title:="Search all workbooks in a folder", Type:=2)
    If Str = "" Then Exit Sub
    WS.Range("A1") = "Search string:"
    WS.Range("B1") = Str
    WS.Range("A2") = "Path:"
    WS.Range("B2") = myfolder
    WS.Range("A3") = "Folderpath"
    WS.Range("B3") = "Workbook"
    WS.Range("C3") = "Worksheet"
    WS.Range("D3") = "Cell Address"
    WS.Range("E3") = "Link"
    Folderpath = myfolder
    Value = Dir(myfolder, &H1F)
Else
    If Right(Folderpath, 2) = "\\" Then
        Exit Sub
    End If
    Value = Dir(Folderpath, &H1F)
End If
Do Until Value = ""
    If Value = "." Or Value = ".." Then
    Else
        If GetAttr(Folderpath & Value) = 16 Then
            Folders(UBound(Folders)) = Value
            ReDim Preserve Folders(UBound(Folders) + 1)
        ElseIf (Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm") And Left(Value, 1) <> "~" Then Then
            On Error Resume Next
            Dim wb As Workbook
            Set wb = Workbooks.Open(Filename:=Folderpath & Value, Password:="zzzzzzzzzzzz")
            On Error GoTo 0
            'If there is an error on Workbooks.Open, then wb Is Nothing:
            If wb Is Nothing Then
                Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
                WS.Range("A" & Lrow).Value = Value
                WS.Range("B" & Lrow).Value = "Password protected"
            Else
                For Each sht In wb.Worksheets
                    'Expand all groups in sheet
                    sht.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8
                    Set c = sht.Cells.Find(Str, After:=sht.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
                    If Not c Is Nothing Then
                        firstAddress = c.Address
                        Do
                            Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
                            WS.Range("A" & Lrow).Value = Folderpath
                            WS.Range("B" & Lrow).Value = Value
                            WS.Range("C" & Lrow).Value = sht.Name
                            WS.Range("D" & Lrow).Value = c.Address
                            WS.Hyperlinks.Add Anchor:=WS.Range("E" & Lrow), Address:=Folderpath & Value, SubAddress:= _
                            "'" & sht.Name & "'" & "!" & c.Address, TextToDisplay:="Link"
                            Set c = sht.Cells.FindNext(After:=c)

                        Loop While Not c Is Nothing And c.Address <> firstAddress
                    End If
                Next sht
                wb.Close False
            End If
        End If
    End If
    Value = Dir
Loop
For Each Folder In Folders
    Call SearchWKBooksSubFolders(Folderpath & Folder & "\", Str)
Next Folder
Cells.EntireColumn.AutoFit
End Sub

致：

“卡住”就像一个无限循环？或者您有错误吗？您可能误用了错误恢复下一步时的
，这可能是在掩盖错误--看起来整个
Else
块都在
恢复下一步中
（假设
工作簿没有错误。请打开
语句。此外，您可能希望避免依赖
ActiveWorkbook
，最好分配给另一个
工作簿
类型对象变量并使用它。是的，我将其打开了大约一个半小时，它仍然位于第一个文件夹/子文件夹的第一个文档上。没有错误@DavidZemens很抱歉，我对VBA Excel没有太多经验，因此我不确定您的解释需要做哪些更改
SearchWKBooksSubFolders (Folderpath & Folder & "\")

Call SearchWKBooksSubFolders(Folderpath & Folder & "\", Str)