我需要帮助来获取此代码以搜索子文件夹

Question

我发现一些vba代码几乎可以满足我的需求。

我只需要能够在我们的文档文件夹中进行搜索，并在Word文档中打开并在其中搜索特定字符串，如果单词文档名称中包含字符串，则返回该单词文档名称。

除了不在子文件夹中搜索之外，该代码执行的操作完全相同。

有什么办法也可以做到吗？

我试图让它每次在for循环中都更改引用的单元格中的地址，但是不幸的是，没有一个一致的文件命名系统，所以我无法让它遍历所有文件夹，而且似乎使程序运行非常缓慢。

谢谢！

Option Explicit

Private Sub cbSearch_Click()

SearchDocs

End Sub

Private Sub SearchDocs()

Dim oWRD As Object '** Word.Application
Dim oDOC As Object '** Word.Document
Dim oFound As Object '** Word.Range

Dim rCell As Excel.Range
Dim lngCol As Long
Dim strFile As String

On Error GoTo ErrHandler



Application.ScreenUpdating = False
lngCol = 1

'** Set oWRD = New Word.Application

Set oWRD = CreateObject("Word.Application")
oWRD.Visible = True

'// XL2007 specific
Sheet1.Range("B2:XFD100000").ClearContents

strFile = Dir$(Sheet1.Range("B1").Value & "\*.doc?")
lngCol = 2

'// loop matching files
Do While strFile <> vbNullString
'open
Set oDOC = oWRD.Documents.Open(Sheet1.Range("B1").Value & "" & strFile)

With Sheet1.Cells(2, lngCol)
.Value = strFile
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 90
.EntireColumn.ColumnWidth = 3.35
End With

For Each rCell In Sheet1.Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)

With oDOC.Content.Find

.ClearFormatting
.Text = rCell.Value
.MatchCase = False
.MatchWholeWord = False

.Execute

If .Found Then
Sheet1.Cells(rCell.Row, lngCol).Value = "x"
End If

End With
Next
Application.ScreenUpdating = True
DoEvents
Application.ScreenUpdating = False
lngCol = lngCol + 1


oDOC.Close
'// get next file
strFile = Dir$()

Loop


MsgBox "Finshed...", vbInformation

ErrHandler:
Application.ScreenUpdating = True
oWRD.Application.Quit

End Sub