VBA‎ > ‎

VBA to find where a file is stored using the file name only

Issue:   with VBA, we knew how to determine the name of a file but we didn't know how to determine with VBA where it was stored on the computer.   For example, we knew the user had a file called "example.doc".    But we didn't know where this file was stored on the computer or the network.    Eventually, we figured out that the VBA code below would work.
 
Here is VBA code to find the path to a file based on a file name only.  You give it a starting directory, and then it searches subfolders as well if you tell it to.
 
Step 1 - Paste the code shown below into your VBA
 
Step 2 - To use this code:
 
Dim strFile As String
strFile = ListFiles("C:\", "example.doc", True)
 
Or if you are searching a network shared drive, you can do it this way:
 
Dim strFile As String
strFile = ListFiles(\\servername\folder\, "example.doc", True)
 
IMPORTANT:   this code may be slow to run if it has to search thousands of files.   If possible, make your starting location as close as possible to where you think the file will be.
 
 
PASTE THIS CODE INTO A VBA MODULE:
 
Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
    Optional bIncludeSubfolders As Boolean, Optional lst As ListBox)
On Error GoTo Err_Handler
    'Purpose:   List the files in the path.
    'Arguments: strPath = the path to search.
    '           strFileSpec = "*.*" unless you specify differently.
    '           bIncludeSubfolders: If True, returns results from subdirectories of strPath as well.
    '           lst: if you pass in a list box, items are added to it. If not, files are listed to immediate window.
    '               The list box must have its Row Source Type property set to Value List.
    'Method:    FilDir() adds items to a collection, calling itself recursively for subfolders.
    Dim colDirList As New Collection
    Dim varItem As Variant
   
    Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)
   
   
    'Add the files to a list box if one was passed in. Otherwise list to the Immediate Window.
    If lst Is Nothing Then
        For Each varItem In colDirList
            ListFiles = varItem
        Next
    Else
        For Each varItem In colDirList
        lst.AddItem varItem
        Next
    End If
Exit_Handler:
    Exit Function
Err_Handler:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Exit_Handler
End Function
Private Function FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _
    bIncludeSubfolders As Boolean)
    'Build up a list of files, and then add add to this list, any additional folders
    Dim strTemp As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant
    'Add the files to the folder.
    strFolder = TrailingSlash(strFolder)
    strTemp = Dir(strFolder & strFileSpec)
    Do While strTemp <> vbNullString
        colDirList.Add strFolder & strTemp
        strTemp = Dir
    Loop
    If bIncludeSubfolders Then
        'Build collection of additional subfolders.
        strTemp = Dir(strFolder, vbDirectory)
        Do While strTemp <> vbNullString
            If (strTemp <> ".") And (strTemp <> "..") Then
                If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
                    colFolders.Add strTemp
                End If
            End If
            strTemp = Dir
        Loop
        'Call function recursively for each subfolder.
        For Each vFolderName In colFolders
            Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
        Next vFolderName
    End If
End Function
Public Function TrailingSlash(varIn As Variant) As String
    If Len(varIn) > 0& Then
        If Right(varIn, 1&) = "\" Then
            TrailingSlash = varIn
        Else
            TrailingSlash = varIn & "\"
        End If
    End If
End Function

 
Comments