Search for file using VBA in MSWord-CodePudding

I need my Macro to search for a specific file without knowing the full file path, then to either open the file or return the file path. I´ve tried searching online but most of the answers don't seem to work for me. The closest I got was a function to search for folders, but I wasn't able to modify it to search for files (courtesy of 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

CodePudding user response：

This is a non-recursive version:

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

Edit - Function version:

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