VBA遍历文件夹及子文件夹搜索Word文件触发Run-time error '5'

错误原因 #

Run-time error '5' 出现在subFolder = Dir行，核心原因是Dir函数的搜索上下文被递归调用破坏：

• Dir函数是单上下文机制，当父过程启动子文件夹的Dir循环后，递归调用SearchWordFilesInFolder时，子过程里的myFile = Dir(folderPath & "*.doc*")会覆盖当前Dir的搜索上下文。
• 回到父过程执行subFolder = Dir时，原有的子文件夹搜索上下文已丢失，导致Dir调用参数无效，触发错误。

此外原代码还有两个额外问题：

• 每次递归都会创建新的Word应用实例，效率极低，且容易残留大量未关闭的Word进程。
• 递归中重复设置ws = ActiveSheet，若操作中切换工作表，会导致数据写入错误。

修正方案 #

采用FileSystemObject遍历文件夹（替代Dir函数，彻底避免上下文冲突），同时将Word应用实例提升到主过程，作为参数传递给递归函数，避免重复创建。

修正后的代码 #

Option Explicit
Option Compare Text

Sub SearchWordFilesInFolder(ByVal folderPath As String, ByVal searchText As String, _
                            ByVal wordApp As Object, ByVal ws As Worksheet, ByRef rowNum As Long)
    Dim fso As Object, folder As Object, subFolder As Object, file As Object
    Dim wordDoc As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)
    
    ' 遍历当前文件夹下的Word文件
    For Each file In folder.Files
        If LCase(fso.GetExtensionName(file.Path)) Like "doc*" Then
            On Error Resume Next ' 捕获无法打开的损坏文件
            Set wordDoc = wordApp.Documents.Open(file.Path)
            On Error GoTo 0
            
            If Not wordDoc Is Nothing Then
                With wordDoc.Content.Find
                    .Text = searchText
                    .MatchCase = False
                    If .Execute Then
                        ws.Cells(rowNum, 1).Value = file.Path
                        rowNum = rowNum + 1
                    End If
                End With
                
                wordDoc.Close False
                Set wordDoc = Nothing
            End If
        End If
    Next file
    
    ' 递归遍历子文件夹
    For Each subFolder In folder.SubFolders
        SearchWordFilesInFolder subFolder.Path & "\", searchText, wordApp, ws, rowNum
    Next subFolder
End Sub

Sub StartSearch()
    Dim folderPath As String, searchText As String
    Dim wordApp As Object, ws As Worksheet
    Dim rowNum As Long
    
    ' 设置文件夹路径和搜索文本
    folderPath = "\\Path of Parent Folder\"
    searchText = "Converted"
    
    ' 初始化工作表和起始行
    Set ws = ActiveSheet
    rowNum = 1
    ' 清空原有数据（可选操作）
    ws.Range("A1:A" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row).ClearContents
    
    ' 创建Word应用实例
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = False
    
    ' 调用搜索函数
    SearchWordFilesInFolder folderPath, searchText, wordApp, ws, rowNum
    
    ' 关闭Word应用
    wordApp.Quit
    Set wordApp = Nothing
    
    MsgBox "搜索完成，共找到 " & rowNum - 1 & " 个匹配文件。"
End Sub

关键改进点 #

• 使用FileSystemObject遍历文件和文件夹，彻底规避Dir函数的上下文冲突问题。
• Word应用实例仅创建一次，通过参数传递给递归函数，提升效率并避免进程残留。
• 新增错误捕获逻辑，处理无法打开的损坏Word文件。
• 工作表对象和起始行作为参数传递，避免递归中的上下文错误。
• 可选清空原有数据，添加搜索完成提示框，提升使用体验。

内容的提问来源于stack exchange，提问作者Peace