在 MSWord 中使用 VBA 搜索文件

Search for file using VBA in MSWord

我需要我的宏在不知道完整文件路径的情况下搜索特定文件,然后打开文件或 return 文件路径。我试过在线搜索,但大多数答案似乎对我不起作用。我得到的最接近的是搜索文件夹的功能,但我无法修改它来搜索文件 (由 https://vbahowto.com/how-to-search-for-a-folder-in-vba/ 提供)。

Sub Main()

Dim fsoFileSystem As Object
Dim strMainFolder As String
Dim strLookFor As String

strLookFor = "working"
strMainFolder = "C:\a"

Set fsoFileSystem = CreateObject("Scripting.FileSystemObject")
DoSubFolders fsoFileSystem.GetFolder(strMainFolder), strLookFor

'if the code didn't find the folder, you will get this message.
Msgbox "'" & strLookFor & "' is not found so go ahead and create it.", vbInformation

End Sub

Sub DoSubFolders(Folder, strLookFor)
Dim objSubFolder As Object

For Each objSubFolder In Folder.SubFolders
    
    Debug.Print "*****************************************"
    Debug.Print "SubFolder= " & objSubFolder.Name
    Debug.Print "*****************************************"
    
    If objSubFolder.Name = strLookFor Then
        MsgBox "You already have a folder called '" & strLookFor & "' at '" & objSubFolder.Path & "' . Don't add it again.", vbInformation
        
        'Exit the search
        End
        
    End If
    
    DoSubFolders objSubFolder, strLookFor
Next
Dim objFile As Object
For Each objFile In Folder.Files
    ' Operate on each file
    Debug.Print "FileName= " & objFile.Name
    
Next
End Sub

这是一个非递归版本:

Sub FindFile()
    'Define the file name and main folder
    Const strLookFor As String = "working"
    Const strMainFolder As String = "C:\a"
    
    Dim targetFilePath As String
        
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim folderColl As Collection
    Set folderColl = New Collection
    folderColl.Add strMainFolder
    
    Do While folderColl.Count <> 0 And targetFilePath = vbNullString
        Dim searchFolder As Object
        Set searchFolder = FSO.GetFolder(folderColl(1))
        
        'Look for the file
        Dim loopFile As Object
        For Each loopFile In searchFolder.Files
            If FSO.GetBaseName(loopFile.Name) = strLookFor Then
                targetFilePath = loopFile.Path
                Exit For
            End If
        Next loopFile
        
        'Add current folder's subfolders into the collection
        Dim loopFolder As Object
        For Each loopFolder In searchFolder.SubFolders
            folderColl.Add loopFolder.Path
        Next loopFolder
        
        folderColl.Remove 1
    Loop
    
    'Check if the file is found
    If targetFilePath <> vbNullString Then
        MsgBox "File found." & vbNewLine & targetFilePath
    Else
        MsgBox "File not found."
    End If
End Sub

编辑 - 函数版本:

Sub Main()
    Dim strLookFor As String
    Dim strMainFolder As String
    
    strLookFor = "working"
    strMainFolder = "D:\Temp\FindFile"
    
    Dim targetFilePath As String
    targetFilePath = FindFile(strMainFolder, strLookFor)
    
    'Check if the file is found
    If targetFilePath <> vbNullString Then
        MsgBox "File found." & vbNewLine & targetFilePath
    Else
        MsgBox "File not found."
    End If
End Sub

Function FindFile(strMainFolder As String, strLookFor As String) As String
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim folderColl As Collection
    Set folderColl = New Collection
    folderColl.Add strMainFolder
    
    Do While folderColl.Count <> 0
        Dim searchFolder As Object
        Set searchFolder = FSO.GetFolder(folderColl(1))
        
        'Look for the file
        Dim loopFile As Object
        For Each loopFile In searchFolder.Files
            If FSO.GetBaseName(loopFile.Name) = strLookFor Then
                FindFile = loopFile.Path
                Exit Function
            End If
        Next loopFile
        
        'Add current folder's subfolders into the collection
        Dim loopFolder As Object
        For Each loopFolder In searchFolder.SubFolders
            folderColl.Add loopFolder.Path
        Next loopFolder
        
        folderColl.Remove 1
    Loop
End Function