在文件夹及其子文件夹内的所有文件中搜索字符串的vba [英] vba that searches for a string in all the files inside a folder and its subfolders

问题描述

我有一个很大的脚本要部分完成(将xml文件解析为vba并删除某些不需要的子级)，但是我感到震惊.

I have a huge script to make which I had partly completed (parsing xml file to vba and deleting certain unwanted childs),but i am struck at one point.

我的工作表中的单元格A1:A1500中有字符串(从先前的输出中获得)，并且我有一个名为"model"的文件夹.在放置我的工作簿的同一路径中(该文件夹有很多子文件夹，并且在子文件夹内有很多.c，.h，.xml文件类型).

I have strings (that are obtained from my previous output) in cells A1:A1500 in my worksheet and I have a folder named "model" in the same path where my workbook is placed (the folder has many subfolders and inside subfolders many .c , .h , .xml file types are present).

我需要一个脚本，该脚本将使用A1中的字符串并在文件夹"model"中的所有文件中进行搜索.以及它的子文件夹，并且如果该字符串存在于任何文件中，我必须打印/放入找到​​的字符串".如果单元格B1中没有该字符串，则必须打印/输入未找到".在单元格B1中.以相同的方式，我需要搜索文件夹"model"中所有文件中来自A2:A1500的所有字符串.并在单元格B2:B1500中打印/输入找到字符串"/.

I need a script that will take the string in A1 and search inside all the files in the folder "model" and its subfolders and if the string is present in any of the files I have to print/put "string found" in cell B1 and if the string is not present in any of the files I have to print/put "Not found" in cell B1. In the same way I need to search all the strings from A2:A1500 inside all the files in the folder "model" and print/put "string found"/not found in the cells B2:B1500.

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

Below are some of the strings I have in my worksheet in column A1:A4:

vel_gradient

vel_gradient

D_speed_20

D_speed_20

AGB_router_1

AGB_router_1

F10_35_XS

F10_35_XS

我对vba有点熟悉，但是我不确定如何实现.

I am somewhat familiar with vba but I am not sure how to implement this.

有关脚本的任何帮助均被接受.有人可以帮我吗?

Any help regarding the script is accepted. Can someone help me with this.

推荐答案

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

As noted in the question comments, the answer to this question involves recursion, which means that one or more sub routines or functions call themselves again and again and again, etc. Fortunately, Excel will keep track of all of this for you. My solution also takes advantage of an Excel trick that allows you to create or unload arrays without iterating by using the Range.Value property. Also included is a string indent variable to help visualize how the recursion is happening. Just comment out the Debug.Print statements when no longer needed.

解决方案涉及3个步骤.

The solution involves 3 steps.

1. 创建一个所有字符串的数组，可以将其与2个并行数组进行匹配，以保存找到的/未找到的字符串以及匹配该字符串的第一个文件

1. Create an array of all of the strings which could be matched along with 2 parallel arrays to hold the found / not found strings and the first file where the string was matched

将3个数组ByRef传递给一个子例程，该子例程处理给定文件夹的所有子文件夹和文件.所有子文件夹都递归回到文件夹子例程中，而文件由单独的文件例程处理.

Pass the 3 arrays ByRef to a sub routine that processes all of the sub folders and files for a given folder. Any sub folders recurse back into the folder sub routine, while files are processed by a separate file routine.

在处理完所有子文件夹和文件后，将从关联的阵列中填充找到/未找到"列.

After all sub folders and files have been processed, the found / not found column is populated from the associated array.

享受

第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步-进程子文件夹方法

Step 2 - The process sub folder method

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的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！