如何在MS Word中用VBA搜索未知完整路径的指定文件并获取路径或打开文件

核心修改说明 #

• 将原代码的文件夹匹配逻辑替换为文件精确匹配逻辑，支持递归遍历指定根目录下所有子文件夹
• 新增交互选项，匹配到目标文件后可选择打开文件、复制完整路径到剪贴板，或继续搜索重名文件
• 适配Word VBA环境，调用原生接口打开Office文件

完整可运行代码 #

' 主搜索入口
Sub SearchTargetFile()
    Dim fsoFileSystem As Object
    Dim strMainFolder As String
    Dim strLookFor As String
    
    ' ************ 这里修改你的搜索参数 ************
    strLookFor = "目标文件名.docx" ' 替换为你要搜索的完整文件名，包含后缀
    strMainFolder = "C:\搜索根目录" ' 替换为你要搜索的顶级文件夹路径
    ' *********************************************

    Set fsoFileSystem = CreateObject("Scripting.FileSystemObject")
    Call RecursiveSearch(fsoFileSystem.GetFolder(strMainFolder), strLookFor)
    
    ' 遍历完所有文件夹未找到的提示
    MsgBox "'" & strLookFor & "' 未在指定目录下找到", vbInformation
End Sub

' 递归搜索子过程
Sub RecursiveSearch(Folder As Object, strLookFor As String)
    Dim objSubFolder As Object
    Dim objFile As Object
    Dim userChoice As Integer
    Dim dataObj As Object
    
    ' 先遍历当前文件夹下的所有文件
    For Each objFile In Folder.Files
        If objFile.Name = strLookFor Then
            ' 匹配到文件后弹出交互框
            userChoice = MsgBox("找到目标文件：" & vbCrLf & objFile.Path & vbCrLf & vbCrLf & _
                               "选【是】打开文件，【否】复制路径到剪贴板，【取消】继续搜索其他重名文件", _
                               vbYesNoCancel + vbInformation, "找到匹配文件")
            
            Select Case userChoice
                Case vbYes
                    ' 用Word直接打开文件
                    Documents.Open objFile.Path
                    End ' 打开后直接结束搜索
                Case vbNo
                    ' 复制路径到剪贴板
                    Set dataObj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
                    dataObj.SetText objFile.Path
                    dataObj.PutInClipboard
                    Set dataObj = Nothing
                    MsgBox "文件路径已复制到剪贴板", vbInformation
                    End ' 复制后结束搜索
                Case vbCancel
                    ' 啥也不做，继续遍历找下一个
            End Select
        End If
    Next
    
    ' 递归遍历所有子文件夹
    For Each objSubFolder In Folder.SubFolders
        Call RecursiveSearch(objSubFolder, strLookFor)
    Next
End Sub

使用注意事项 #

• 文件名需要输入完整后缀，比如要搜索预算.xlsx就不能只写预算，如果需要模糊匹配可以把判断条件改成If InStr(objFile.Name, strLookFor) > 0 Then
• 如果搜索的目录层级多、文件量大，搜索过程可能会有卡顿，属于正常现象
• 如果要搜索的是Word以外的文件，把Documents.Open objFile.Path改成Shell "explorer.exe """ & objFile.Path & """", vbNormalFocus即可调用系统默认程序打开

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