Question

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

我在工作表的单元格A1：A1500中有字符串（从我之前的输出中获得），我有一个名为＆＃34; model＆＃34;的文件夹。在我的工作簿所在的同一路径中（该文件夹有许多子文件夹，在子文件夹中有很多.c，.h，.xml文件类型）。

我需要一个脚本，它将获取A1中的字符串并搜索文件夹中的所有文件＆＃34; model＆＃34;和它的子文件夹，如果字符串出现在我必须打印/放置的任何文件中，＃34;字符串找到＆＃34;在单元格B1中，如果字符串不存在于任何文件中，我必须打印/放置＆＃34;未找到＆＃34;在单元格B1中。同样地，我需要搜索A2中的所有字符串：A1500文件夹中的所有文件＆＃34; model＆＃34;并打印/放置＆＃34;找到字符串＆＃34; /在单元格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

Answer 2

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

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（）检查每个字符串会更有效

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

2 个答案: