'Name of Sub Routine
Sub foobar()
'Late Bind Variable for the File Scripting Object
Dim fso As Object
'String Variable for working with the Dir() function
Dim strName As String
'Array of Strings Variable - it's 2d, and Long Integer Variable
Dim strArr(1 To 65536, 1 To 1) As String, i As Long
'String Constant for root Search Folder
Const strDir As String = "C:\temp"
'This is our search term constant
Const searchTerm As String = "production"
'Locate first file with our search term and .xls extension
'Within our root folder
Let strName = Dir$(strDir & "\*" & searchTerm & "*.xls")
'Start looking for the next files
Do While strName <> vbNullString
'Use a counter, to populate our 1-based, 2d Array of Strings
Let i = i + 1
'Popupulate the appropriate element within the Array
Let strArr(i, 1) = strDir & "\" & strName
'Find the next matching file
Let strName = Dir$()
'Keep going through root folder
Loop
'Late bind with FSO, we're using this to 'walk through' subfolders
Set fso = CreateObject("Scripting.FileSystemObject")
'Call our recursive procedure
'We Marshall our variables byRef as we're going to manipulate them
'This allows us to avoid using Public Variables
Call recurseSubFolders(fso.GetFolder(strDir), strArr(), i, searchTerm)
'We're done with FSO, terminate it
Set fso = Nothing
'Lets make sure we actually found at least one match
If i > 0 Then
'Pass our 2d Array of Strings to the Worksheet
Range("A1").Resize(i).Value = strArr
'End of our conditional
End If
'End of our routine
End Sub
'Here's our recursive Sub Routine, we use this to walk Sub Directories
Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, _
ByRef i As Long, _
ByRef searchTerm As String)
'Late bind to Work with FSO's SubFolder Object
Dim SubFolder As Object
'String Variable for working with the Dir() function
Dim strName As String
'Loop for iterating through each SubFolder Object in the Root Folder
For Each SubFolder In Folder.SubFolders
'Use Dir() to return a potential match
Let strName = Dir$(SubFolder.Path & "\*" & searchTerm & "*.xls")
'Start looking for the next files
Do While strName <> vbNullString
'Use a counter, to populate our 1-based, 2d Array of Strings
Let i = i + 1
'Popupulate the appropriate element within the Array
Let strArr(i, 1) = SubFolder.Path & "\" & strName
'Find the next matching file
Let strName = Dir$()
'Keep going through the Subfolder folder
Loop
'Call the recursive routine, we want to walk through Subfolders
'Of each Subfolder, and so forth, capturing the entire tree of Folders
Call recurseSubFolders(SubFolder, strArr(), i, searchTerm)
'Next SubFolder Object
Next
'End of our routine
End Sub
