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!
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 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