在文件夹及其子文件夹中的所有文件中搜索字符串的vba

我有一个巨大的脚本要编写，我已经部分完成了（将xml文件解析为vba并删除某些不需要的孩子），但有一点让我大吃一惊

我的工作表A1:A1500单元格中有字符串（从以前的输出中获得），我的工作簿所在路径中有一个名为“model”的文件夹（该文件夹有许多子文件夹，子文件夹中有许多.c、.h、.xml文件类型）

我需要一个脚本，它将在A1中获取字符串，并在文件夹“model”及其子文件夹中的所有文件中进行搜索，如果字符串存在于任何文件中，我必须在单元格B1中打印/放置“string found”，如果字符串不存在于任何文件中，我必须在单元格B1中打印/放置“not found”。同样，我需要在文件夹“model”中的所有文件中搜索A2:A1500中的所有字符串，并在单元格B2:B1500中打印/放置“string found”/“not found”

以下是我工作表A1:A4列中的一些字符串：

水平梯度

D_速度_20

AGB_路由器_1

F10_35_XS

我有点熟悉vba，但我不知道如何实现这一点

---

接受有关脚本的任何帮助。有人能帮我吗。

如果您的文件不太大，您可以一次读取所有内容：

Sub Tester()

    Debug.Print StringInFile("C:\_Stuff\test\File_Val2.txt", "xxx")

End Sub


Function StringInFile(fPath, txtSearch) As Boolean
    StringInFile = InStr(CreateObject("scripting.filesystemobject").opentextfile( _
                         fPath).Readall(), txtSearch) > 0
End Function

---

但是，如果需要测试多个字符串，则更有效的方法是读取一次文件，然后使用instr（）检查每个字符串，如问题注释中所述，此问题的答案涉及递归，这意味着一个或多个子例程或函数会一次又一次地调用自己，等等。幸运的是，Excel将为您跟踪所有这些信息。我的解决方案还利用了一个Excel技巧，它允许您通过使用Range.Value属性创建或卸载数组，而无需进行迭代。还包括一个字符串缩进变量，以帮助可视化递归是如何发生的。不再需要时，只需注释掉Debug.Print语句即可

解决方案包括3个步骤

创建一个包含所有可匹配字符串的数组，以及两个并行数组，以保存找到/未找到的字符串和匹配字符串的第一个文件

将3个数组ByRef传递给处理给定文件夹的所有子文件夹和文件的子程序。任何子文件夹都会递归回到文件夹子例程中，而文件则由单独的文件例程处理

处理完所有子文件夹和文件后，将从关联数组填充“已找到/未找到”列

享受

步骤1-主要方法

' The main sub routine.
Public Sub FindStrings(strFolder As String, Optional wksSheet As Worksheet = Nothing)
' Used examples given, better to convert to variables and calculate at run time.
Const lngFirstRow As Long = 1
Const lngLasstRow As Long = 1500
Const strStringsCol As String = "A"
Const strMatchesFoundCol As String = "B"
Const strFileNamesCol As String = "C"

Dim lngIndex As Long, lngFolderCount As Long, lngFileCount As Long
Dim strIndent As String
Dim varStrings As Variant, varMatchesFound As Variant, varFileNames As Variant

    If wksSheet Is Nothing Then
        Set wksSheet = ActiveSheet
    End If

    With wksSheet
        ' Create the strings array from the given range value.
        varStrings = .Range(.Cells(lngFirstRow, strStringsCol), .Cells(lngLasstRow, strStringsCol)).Value
        ' Transpose the strings array into a one dimentional array.
        varStrings = Application.WorksheetFunction.Transpose(varStrings)
    End With

    ' Initialize file names array to empty strings.
    ReDim varFileNames(LBound(varStrings) To UBound(varStrings))
    For lngIndex = LBound(varFileNames) To UBound(varFileNames)
        varFileNames(lngIndex) = vbNullString
    Next

    ' Initialize matches found array to empty strings.
    ReDim varMatchesFound(LBound(varStrings) To UBound(varStrings))
    For lngIndex = LBound(varMatchesFound) To UBound(varMatchesFound)
        varMatchesFound(lngIndex) = vbNullString
    Next

    ' Process the main folder.
    Call ProcessFolder(strFolder, strIndent, varStrings, varMatchesFound, varFileNames, lngFolderCount, lngFileCount)

    ' Finish setting up matches found array.
    For lngIndex = LBound(varMatchesFound) To UBound(varMatchesFound)
        If Len(Trim$(varMatchesFound(lngIndex))) = 0 Then
            varMatchesFound(lngIndex) = "Not found"
        End If
    Next

    ' Transpose the associated arrays so we can use them to load found / not found and file names columns.
    varFileNames = Application.WorksheetFunction.Transpose(varFileNames)
    varMatchesFound = Application.WorksheetFunction.Transpose(varMatchesFound)

    ' Set up the found / not found column data from the matches found array.
    With wksSheet
        .Range(.Cells(lngFirstRow, strFileNamesCol), .Cells(lngLasstRow, strFileNamesCol)).Value = varFileNames
        .Range(.Cells(lngFirstRow, strMatchesFoundCol), .Cells(lngLasstRow, strMatchesFoundCol)).Value = varMatchesFound
    End With

    Debug.Print "Folders: "; lngFolderCount, "Files: "; lngFileCount
End Sub

步骤2-流程子文件夹方法

Private Sub ProcessFolder(strFolder As String, ByRef strIndent As String, ByRef varStrings As Variant, ByRef varMatchesFound As Variant, ByRef varFileNames As Variant, ByRef lngFolderCount As Long, lngFileCount As Long)
Dim objFileSystemObject As Object, objFolder As Object, objFile As Object

    ' Use late binding throughout this method to avoid having to set any references.
    Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
    lngFolderCount = lngFolderCount + 1
    Debug.Print strIndent & "Dir: " & Format(lngFolderCount, "###,##0 ") & strFolder

    For Each objFolder In objFileSystemObject.GetFolder(strFolder).SubFolders
        If objFolder.Name = "history" Then
            'Do Nothing
        Else
            ' Recurse with the current sub folder.
            Call ProcessFolder(objFolder.Path, strIndent & "    ", varStrings, varMatchesFound, varFileNames, lngFolderCount, lngFileCount)
        End If
    Next

    ' Process any files found in the current folder.
    For Each objFile In objFileSystemObject.GetFolder(strFolder).Files
        Call ProcessFile(objFile.Path, strIndent & "    ", varStrings, varMatchesFound, varFileNames, lngFileCount)
    Next

    Set objFileSystemObject = Nothing: Set objFolder = Nothing: Set objFile = Nothing
End Sub

步骤3-流程文件方法

Private Sub ProcessFile(strFullPath As String, ByRef strIndent As String, ByRef varStrings As Variant, ByRef varMatchesFound As Variant, ByRef varFileNames As Variant, ByRef lngFileCount As Long)
On Error Resume Next
Dim objFileSystemObject As Object
Dim strFileContent As String
Dim lngIndex As Long
    lngFileCount = lngFileCount + 1
    Debug.Print strIndent & "File: " & Format(lngFileCount, "###,##0 ") & strFullPath

    ' Use late binding throughout this method to avoid having to set any references.
    Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
    strFileContent = objFileSystemObject.OpenTextFile(strFullPath).Readall()
    If Err.Number = 0 Then
        ' Check for matched strings by iterating over the strings array.
        For lngIndex = LBound(varStrings) To UBound(varStrings)
            ' Skip zero length strings.
            If Len(Trim$(varStrings(lngIndex))) > 0 Then
                ' We have a matched string.
                If InStr(1, strFileContent, varStrings(lngIndex), vbTextCompare) > 0 Then
                    ' Set up parallel arrays the first time the string is matched.
                    If Len(Trim$(varMatchesFound(lngIndex))) = 0 Then
                        ' Set corresponding array value.
                        varMatchesFound(lngIndex) = "String found"
                        ' Save file name where first match was found.
                        varFileNames(lngIndex) = strFullPath
                    End If
                End If
            End If
        Next
    Else
        Err.Clear
    End If
    Set objFileSystemObject = Nothing
On Error GoTo 0
End Sub

---

在本页右侧的“相关”标题下，您可以找到在文件夹/子文件夹中搜索文件的示例。如果您遇到问题，请尝试其中一种方法，并用代码发回。搜索文件夹和子文件夹需要递归，这需要花费一点时间来解决。搜索文件内容中的字符串意味着将文本加载到内存中，因此我将其设置为只打开每个文件一次，同时查找所有字符串，以提高性能。我在谷歌上搜索了一些可能性，在这里，我找到了一些示例，可以在文件夹/子文件夹中搜索带有文件名的字符串，但是，我没有找到任何使用VBA在文件夹/子文件夹中的所有文件中搜索字符串的内容。这就是为什么我问了一个问题，否则我会跟随并修改@Tim Williams的一些帖子。这个网站是为了帮助你处理你试图使用的代码：通常要求完整答案的问题不会得到很好的回答。如果你自己开始解决这个问题并取得一些进展，你就更有可能得到帮助。例如，这其中哪一部分给了你一个问题？找到所有的文件了吗？在文件中搜索特定文本段？还有什么吗？是的，我明白你的逻辑，事实上，性能对我来说并不重要，即使我的脚本需要3-5分钟才能完成，并向我展示结果，它很好。你能帮我写代码吗？因为我不知道如何实现@Portland RunnerI从另一个子系统调用子FindStrings，比如

Call FindStrings（strFolder，Nothing）

，但它抛出一个错误，说子系统或函数未定义，并在FindStrings（）停止执行它还突出显示了

callprocessfolder

我需要调用/运行

FindStrings

在另一个子节点的末尾，我有文件夹路径作为字符串传递，或者如果它提示用户选择文件夹会更好@j2associatesI尝试将FindString放在标准模块中，将ProcessFile&ProcessFolder放在类模块中，但也无法工作。抛出了相同的错误。你能帮忙吗@j2associates@S6633d：所有三个子例程应包含在同一标准模块中。如果希望它们位于单独的模块中，则将它们全部更改为Public。此外，在VBA编辑器中，单击“调试”菜单，然后选择“编译VBA项目”。这将突出显示您可能存在的任何编译错误，以便您可以修复它们。只需稍微调整代码，以便Debug.Print语句将正确显示递归结果。代码的基本功能没有改变。