Return File Paths in Collection Using FileSystemObject Object
Utilization (Example)
Sub CollSubfolderFilePathsTEST()
' Define constants.
Const FolderPath As String = "C:\Test"
Const FilePattern As String = "*.xlsm"
Const IncludeFolderPath As Boolean = False
' Return the file paths in a collection ('collFilePaths')
Dim collFilePaths As Collection: Set collFilePaths _
= CollSubfolderFilePaths(FolderPath, FilePattern, IncludeFolderPath)
' Validate the collection.
If collFilePaths Is Nothing Then Exit Sub
Dim Item As Variant
' Loop through the collection to print each item.
For Each Item In collFilePaths
Debug.Print Item
Next Item
End Sub
The Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the paths of all files of a folder ('FolderPath')
' and all of its subfolders in a collection.
' Remarks: It uses the FileSystemObject object.
' If an error occurs, if the initial folder doesn't exist, or
' if no file is found, the function will return 'Nothing'.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function CollSubfolderFilePaths( _
ByVal FolderPath As String, _
Optional ByVal FilePattern As String = "*.*", _
Optional ByVal IncludeFolderPath As Boolean = True) _
As Collection
Const ProcName As String = "CollSubfolderFilePaths"
On Error GoTo ClearError
' Create and reference a FileSystemObject object ('fso').
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
' Validate the initial folder path ('FolderPath').
If Not fso.FolderExists(FolderPath) Then Exit Function
' Define the Paths collection ('collPaths') to hold the paths of all files
' in the initial folder path and in each of its subfolders.
Dim collPaths As Collection: Set collPaths = New Collection
' Define the Queue collection ('collQueue') to hold
' the initial folder (object) and all of its subfolders (objects)
' before the paths of their files are stored in the Paths collection
' and they are removed (from the Queue collection).
Dim collQueue As Collection: Set collQueue = New Collection
' Add the initial folder (object) to the Queue collection.
collQueue.Add fso.GetFolder(FolderPath)
Dim fsoFolder As Object ' Current Folder
Dim fsoSubfolder As Object ' Current Subfolder
Dim fsoFile As Object ' Current File in the Current Folder
Do Until collQueue.Count = 0
' Reference the current folder ('fsoFolder'),
' the first folder in the Queue collection.
Set fsoFolder = collQueue(1)
' Remove the current (first) folder from the Queue collection.
collQueue.Remove 1 ' dequeue!
' Loop through the subfolders ('fsoSubfolder') of the current folder.
For Each fsoSubfolder In fsoFolder.Subfolders
' Add the current subfolder to the Queue collection.
collQueue.Add fsoSubfolder ' enqueue!
Next fsoSubfolder
If IncludeFolderPath Then ' do not skip the intial folder path
' Loop through the files ('fsoFile') in the folder.
For Each fsoFile In fsoFolder.Files
' Using the Like operator, check the current file's name
' against the file pattern ensuring case-insensitivity
' by using the LCase function.
If LCase(fsoFile.Name) Like LCase(FilePattern) Then
' Add the current file's path to the collection.
collPaths.Add fsoFile.Path
End If
Next fsoFile
Else ' skip the initial folder path
IncludeFolderPath = True
End If
Loop
' When no file was found, avoid passing a collection with 0 items
' to be able to always validate it by checking it just against 'Nothing'
' in the calling procedure.
If collPaths.Count = 0 Then Exit Function
' Pass the Paths collection to the result of the function.
Set CollSubfolderFilePaths = collPaths
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Function
Return Folder Paths in Collection Using FileSystemObject Object
Utilization (Example)
Sub CollSubfolderPathsTEST()
' Define constants.
Const FolderPath As String = "C:\Test"
Const IncludeFolderPath As Boolean = True
' Return the folder paths in a collection ('collFolderPaths')
Dim collFolderPaths As Collection: Set collFolderPaths _
= CollSubfolderPaths(FolderPath, IncludeFolderPath)
' Validate the collection.
If collFolderPaths Is Nothing Then Exit Sub
Dim Item As Variant
' Loop through the collection to print each item.
For Each Item In collFolderPaths
Debug.Print Item
Next Item
End Sub
The Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the paths of a folder ('FolderPath')
' and all of its subfolders in a collection.
' Remarks: It uses the FileSystemObject object.
' If an error occurs, if the initial folder doesn't exist, or
' if no folder is found (only when 'IncludFolderPath = False'),
' the function will return 'Nothing'.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function CollSubfolderPaths( _
ByVal FolderPath As String, _
Optional ByVal IncludeFolderPath As Boolean = True) _
As Collection
Const ProcName As String = "CollSubFolderPaths"
On Error GoTo ClearError
' Create and reference a FileSystemObject object ('fso').
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
' Validate the initial folder path ('FolderPath').
If Not fso.FolderExists(FolderPath) Then Exit Function
' Define the Paths collection ('collPaths') to hold
' the initial folder path and the paths of each subfolder.
Dim collPaths As Collection: Set collPaths = New Collection
' Define the Queue collection ('collQueue') to hold
' the initial folder (object) and all of its subfolders (objects)
' before their path is stored in the Paths collection
' and they are removed (from the Queue collection).
Dim collQueue As Collection: Set collQueue = New Collection
' Add the initial folder (object) to the Queue collection.
collQueue.Add fso.GetFolder(FolderPath)
Dim fsoFolder As Object ' Current Folder
Dim fsoSubfolder As Object ' Current Subfolder
Do Until collQueue.Count = 0
' Reference the current folder ('fsoFolder'),
' the first folder in the Queue collection.
Set fsoFolder = collQueue(1)
' Remove the current (first) folder from the Queue collection.
collQueue.Remove 1 ' dequeue!
' Add the path of the current folder to the Paths collection.
collPaths.Add fsoFolder.Path
' Loop through the subfolders of the current folder (referencing each).
For Each fsoSubfolder In fsoFolder.Subfolders
' Add the current subfolder to the Queue collection.
collQueue.Add fsoSubfolder ' enqueue!
Next fsoSubfolder
Loop
' The following illustration helped me to understand the code
' in the Do...Until loop whose part related to the Queue collection
' is emulating the functionality of a FIFO type (first in, first out)
' data structure called a queue.
' Level Folder Structure
' 1 A
' 2 B C D
' 3 E F G H I
' 4 J
' Iteration Removed Path Added Added Description Count Status
' 1 A A B,C,D Subfolders of A 3 B,C,D
' 2 B A\B E,F Subfolders of B 4 C,D,E,F
' 3 C A\C 3 D,E,F
' 4 D A\D G,H,I Subfolders of D 5 E,F,G,H,I
' 5 E A\B\E 4 F,G,H,I
' 6 F A\B\F 3 G,H,I
' 7 G A\D\G J Subfolders of G 3 H,I,J
' 8 H A\D\H 2 I,J
' 9 I A\D\I 1 J
' 10 J A\D\G\J 0
If Not IncludeFolderPath Then
' When the path of the initial folder was the only path
' in the Paths collection, avoid passing a collection with 0 items
' to be able to always validate it by checking it just against 'Nothing'
' in the calling procedure.
If collPaths.Count = 1 Then Exit Function
' Remove the path of the initial folder from the Paths collection.
collPaths.Remove 1
End If
' Pass the Paths collection to the result of the function.
Set CollSubfolderPaths = collPaths
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Function
