正如问题cmets中所指出的，这个问题的答案涉及递归，这意味着一个或多个子例程或函数一次又一次地调用自己，等等。幸运的是，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