Unicode-Safe Filtered Filename Lookups

Need a Unicode-safe way to retrieve a list of filenames from a folder? And its subfolders? And filtered by filename? It's all here!

Unicode-Safe Filtered Filename Lookups

In the past, I've written about the subtle dangers of the Dir() function in VBA.  Today, I went to use a function I had written years ago that I had implemented via the Dir() function.  Heeding my own advice, I updated the function to use the FileSystemObject instead.  Using FSO also ensures that the function works with Unicode file names.

GetFileList()

The function is named GetFileList().  It returns a collection of full file paths to existing files within a folder.  The list of files can be filtered by including wildcard characters in the FileSpec argument.  The function uses the VBA Like wildcard characters, which means you can use ?, *, #, along with character ranges.

You have the option of recursing through subfolders to find matching filenames.

If the folder does not exist, an empty collection is returned.

If you lack permission to open a subfolder, that subfolder is skipped without generating an error.

You can pass an existing collection to the function and any filenames found will be appended to it.  Outside of a few edge cases, you likely won't bother with that.  The ExistingFileList argument is mainly there to support the recursive function calls.

Sample Usage

Sub TestGetFileList()
    Dim FileColl As Collection
    Set FileColl = GetFileList("C:\Users\Mike\Downloads", "*[abcw-z].jpg", True)
    
    Select Case FileColl.Count
    Case 0
        MsgBox "No matching files found"
    Case 1
        MsgBox "Found one file: " & vbNewLine & _
               vbNewLine & FileColl.Item(1)
    Case Else ' i.e., 2+ matches
        'Show the count and first two matches
        MsgBox "Found " & FileColl.Count & " files." & vbNewLine & _
               vbNewLine & FileColl.Item(1) & _
               vbNewLine & FileColl.Item(2)
    End Select
End Sub
The default MsgBox implementation doesn't display it, but that's a Unicode check mark (√) in the file name

The Code

Make sure you have a reference to the Microsoft Scripting Runtime, as I use early-binding in the code below when creating the FileSystemObject.

'---------------------------------------------------------------------------------------
' Purpose   : Returns a collection of full paths to existing files that match the FileSpec.
' Notes     - FileSpec supports wildcard characters
'           - FolderPath may be passed with or without trailing slash
'           - Skips over folders to which we have no access without erroring
'  12/23/20 - Switched from Dir() to FileSystemObject to avoid subtle bugs;
'               see: https://nolongerset.com/the-subtle-dangers-of-dir/
'---------------------------------------------------------------------------------------
'
Public Function GetFileList(FolderPath As String, FileSpec As String, IncludeSubFolders As Boolean, _
                            Optional ExistingFileList As Collection = Nothing) As Collection
    'This is here so we can break out of a long-running process,
    '   especially when recursively processing subfolders
    DoEvents
    
    'The ExistingFileList argument is primarily here to support recursion
    Dim FList As Collection
    If ExistingFileList Is Nothing Then
        Set FList = New Collection
    Else
        Set FList = ExistingFileList
    End If

    'Check to see if the folder exists; if not return without an error
    Dim fso As New FileSystemObject
    If Not fso.FolderExists(FolderPath) Then
        Set GetFileList = FList
        Exit Function
    End If

    Dim FolderObj As Folder
    Set FolderObj = fso.GetFolder(FolderPath)
    
    'Skip processing folders for which we don't have permissions
    Dim FilesObj As Files, FileObj As File, Dummy As String
    On Error Resume Next
    Set FilesObj = FolderObj.Files
    For Each FileObj In FilesObj
        Select Case Err.Number
        Case 70  'Access denied
            Set GetFileList = FList
            Exit Function
        Case 0
            'No errors; we can continue
        Case Else
            'https://nolongerset.com/throwing-errors-in-vba/
            Throw "Error {0} opening folder {1}:\n\n{2}", Err.Number, FolderPath, Err.Description
        End Select
        On Error GoTo 0
        
        Exit For  'There's no other way to get the first item in a Files
                  '   collection than by using a For Each loop; we're just
                  '   testing the first item though to see if we even have
                  '   permission to see it
    Next FileObj
    
    'Get all the matching files in the current directory
    For Each FileObj In FilesObj
        If FileObj.Name Like FileSpec Then
            FList.Add FileObj.Path
        End If
    Next FileObj
    
    'Recursively iterate through subfolders if requested
    If IncludeSubFolders Then
        Dim SubFolderObj As Folder
        For Each SubFolderObj In FolderObj.SubFolders
            Set FList = GetFileList(SubFolderObj.Path, FileSpec, True, FList)
        Next SubFolderObj
    End If

    Set GetFileList = FList
End Function

Image by acertmsweeper from Pixabay

All original code samples by Mike Wolfe are licensed under CC BY 4.0