vba搜索一個文件夾及其子文件夾內的所有文件中的字符串

Question

我有一個巨大的腳本，使我已經部分完成（解析xml文件到vba和刪除某些不想要的孩子），但我在一個點。

我有一個字符串（這是我以前的輸出中獲得）的單元格A1：A1500在我的工作，我有一個在同一路徑下命名爲「模型」文件夾，我的工作簿放置（文件夾中有很多子和內子文件夾中存在許多.c，.h，.xml文件類型）。

我需要一個腳本，它將採用A1中的字符串並搜索文件夾「model」及其子文件夾中的所有文件，並且如果字符串存在於任何文件中，我必須打印/放置「string found 「在單元格B1中，如果該字符串不存在於任何必須在單元格B1中打印/放置」未找到「的文件中。以同樣的方式，我需要搜索文件夾「model」中所有文件中A2：A1500的所有字符串，並在單元格B2：B1500中打印/放置「找到字符串」/未找到。

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

vel_gradient

D_speed_20

AGB_router_1

F10_35_XS

我對vba bu有點熟悉我不知道如何實現這一點。

接受任何關於腳本的幫助。有人可以幫我弄這個嗎。

Answer 1

正如在問題的評論中指出的，這個問題的答案涉及遞歸，這意味着一個或多個子例程或函數自我調用一次又一次，等等。幸運的是，Excel將跟蹤所有這些爲你。我的解決方案還利用了Excel技巧，允許您創建或卸載數組而無需使用Range.Value屬性進行迭代。還包括一個字符串縮進變量，以幫助可視化遞歸如何發生。不再需要時，只需註釋掉Debug.Print語句即可。

該解決方案涉及3個步驟。

1. 創建所有可能連同2個平行陣列保持發現/沒有發現字符串，並且其中該字符串被匹配

2. 第一文件傳遞的3個陣列相匹配的字符串的數組通過參考處理給定文件夾的所有子文件夾和文件的子例程。任何子文件夾遞歸回文件夾子例程，而文件由單獨的文件例程處理。

3. 處理好所有子文件夾和文件後，找到的/未找到的列將從關聯的數組中填充。

享受

步驟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（）