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

Question

我有一个巨大的脚本要制作，我已经部分完成(将 xml 文件解析为 vba 并删除某些不需要的 child )，但我有一点被打动了。
我在工作表的单元格 A1:A1500 中有字符串(从我以前的输出中获得)，并且在放置工作簿的同一路径中有一个名为“model”的文件夹(该文件夹有许多子文件夹，子文件夹中有许多 .c , .h , .xml 文件类型存在)。
我需要一个脚本，它将获取 A1 中的字符串并在文件夹“model”及其子文件夹中的所有文件中搜索，如果该字符串存在于任何文件中，我必须在单元格 B1 中打印/放置“找到的字符串”如果字符串不存在于任何文件中，我必须在单元格 B1 中打印/放置“未找到”。以同样的方式，我需要在“模型”文件夹中的所有文件中搜索 A2:A1500 中的所有字符串，并在单元格 B2:B1500 中打印/放置“找到的字符串”/未找到的字符串。
以下是我在工作表 A1:A4 列中的一些字符串:

vel_gradient

D_speed_20

AGB_router_1

F10_35_XS

我对 vba 有点熟悉，但我不确定如何实现这一点。
接受有关脚本的任何帮助。有人可以帮我弄这个吗。

Answer 1

正如问题评论中所指出的，这个问题的答案涉及递归，这意味着一个或多个子例程或函数一次又一次地调用自己，等等。幸运的是，Excel 会为您跟踪所有这些。我的解决方案还利用了一个 Excel 技巧，该技巧允许您创建或卸载数组，而无需使用 Range.Value 属性进行迭代。还包括一个字符串缩进变量，以帮助可视化递归是如何发生的。只需在不再需要时注释掉 Debug.Print 语句。

解决方案包括 3 个步骤。

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

将 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