Adaptive a vba excel function to be recursive - recursion

Question

Im having trouble converting a working solution that takes a directory folder as an input and outputs the filenames and other file attributes of files container in the folder into an excel spreadsheet to a recursive solution that also outputs the files contained in subfolders. I would greatly appreciate any help!
Sub GetFileList()
Dim strFolder As String
Dim varFileList As Variant
Dim FSO As Object, myFile As Object
Dim myResults As Variant
Dim l As Long
' Get the directory from the user
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then Exit Sub
'user cancelled
strFolder = .SelectedItems(1)
End With
' Get a list of all the files in this directory. ' Note that this isn't recursive... although it could be...
varFileList = fcnGetFileList(strFolder)
If Not IsArray(varFileList) Then
MsgBox "No files found.", vbInformation
Exit Sub
End If
' Now let's get all the details for these files ' and place them into an array so it's quick to dump to XL.
ReDim myResults(0 To UBound(varFileList) + 1, 0 To 5)
' place make some headers in the array
myResults(0, 0) = "Filename"
myResults(0, 1) = "Size"
myResults(0, 2) = "Created"
myResults(0, 3) = "Modified"
myResults(0, 4) = "Accessed"
myResults(0, 5) = "Full path"
Set FSO = CreateObject("Scripting.FileSystemObject")
' Loop through our files
For l = 0 To UBound(varFileList)
Set myFile = FSO.GetFile(CStr(varFileList(l)))
myResults(l + 1, 0) = CStr(varFileList(l))
myResults(l + 1, 1) = myFile.Size
myResults(l + 1, 2) = myFile.DateCreated
myResults(l + 1, 3) = myFile.DateLastModified
myResults(l + 1, 4) = myFile.DateLastAccessed
myResults(l + 1, 5) = myFile.Path
Next l
' Dump these to a worksheet
fcnDumpToWorksheet myResults
'tidy up
Set myFile = Nothing
Set FSO = Nothing
End Sub
Private Function fcnGetFileList(ByVal strPath As String, Optional strFilter As String) As Variant ' Returns a one dimensional array with filenames ' Otherwise returns False
Dim f As String
Dim i As Integer
Dim FileList() As String
If strFilter = "" Then strFilter = "."
Select Case Right$(strPath, 1)
Case "\", "/"
strPath = Left$(strPath, Len(strPath) - 1)
End Select
ReDim Preserve FileList(0)
f = Dir$(strPath & "\" & strFilter)
Do While Len(f) > 0
ReDim Preserve FileList(i) As String
FileList(i) = f
i = i + 1
f = Dir$()
Loop
If FileList(0) <> Empty Then
fcnGetFileList = FileList
Else
fcnGetFileList = False
End If
End Function
Private Sub fcnDumpToWorksheet(varData As Variant, Optional mySh As Worksheet)
Dim iSheetsInNew As Integer
Dim sh As Worksheet, wb As Workbook
Dim myColumnHeaders() As String
Dim l As Long, NoOfRows As Long
If mySh Is Nothing Then
'make a workbook if we didn't get a worksheet
iSheetsInNew = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set wb = Application.Workbooks.Add
Application.SheetsInNewWorkbook = iSheetsInNew
Set sh = wb.Sheets(1)
Else
Set mySh = sh
End If
With sh
Range(.Cells(1, 1), .Cells(UBound(varData, 1) + 1, UBound(varData, 2) + 1)) = varData
.UsedRange.Columns.AutoFit
End With
Set sh = Nothing
Set wb = Nothing
End Sub

Answer 1

I've rewritten the code to pass your results array and a counter to the recursive function. The function fills the array and calls itself with any subfolders
Sub GetFileList()
Dim strFolder As String
Dim FSO As Object
Dim fsoFolder As Object
Dim myResults As Variant
Dim lCount As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
' Get the directory from the user
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then Exit Sub
'user cancelled
strFolder = .SelectedItems(1)
End With
Set fsoFolder = FSO.GetFolder(strFolder)
'the variable dimension has to be the second one
ReDim myResults(0 To 5, 0 To 0)
' place make some headers in the array
myResults(0, 0) = "Filename"
myResults(1, 0) = "Size"
myResults(2, 0) = "Created"
myResults(3, 0) = "Modified"
myResults(4, 0) = "Accessed"
myResults(5, 0) = "Full path"
'Send the folder to the recursive function
FillFileList fsoFolder, myResults, lCount
' Dump these to a worksheet
fcnDumpToWorksheet myResults
'tidy up
Set FSO = Nothing
End Sub
Private Sub FillFileList(fsoFolder As Object, ByRef myResults As Variant, ByRef lCount As Long, Optional strFilter As String)
Dim i As Integer
Dim fsoFile As Object
Dim fsoSubFolder As Object
Dim fsoSubFolders As Object
'load the array with all the files
For Each fsoFile In fsoFolder.Files
lCount = lCount + 1
ReDim Preserve myResults(0 To 5, 0 To lCount)
myResults(0, lCount) = fsoFile.Name
myResults(1, lCount) = fsoFile.Size
myResults(2, lCount) = fsoFile.DateCreated
myResults(3, lCount) = fsoFile.DateLastModified
myResults(4, lCount) = fsoFile.DateLastAccessed
myResults(5, lCount) = fsoFile.Path
Next fsoFile
'recursively call this function with any subfolders
Set fsoSubFolders = fsoFolder.SubFolders
For Each fsoSubFolder In fsoSubFolders
FillFileList fsoSubFolder, myResults, lCount
Next fsoSubFolder
End Sub
Private Sub fcnDumpToWorksheet(varData As Variant, Optional mySh As Worksheet)
Dim iSheetsInNew As Integer
Dim sh As Worksheet, wb As Workbook
Dim myColumnHeaders() As String
Dim l As Long, NoOfRows As Long
If mySh Is Nothing Then
'make a workbook if we didn't get a worksheet
iSheetsInNew = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set wb = Application.Workbooks.Add
Application.SheetsInNewWorkbook = iSheetsInNew
Set sh = wb.Sheets(1)
Else
Set mySh = sh
End If
'since we switched the array dimensions, have to transpose
With sh
Range(.Cells(1, 1), .Cells(UBound(varData, 2) + 1, UBound(varData, 1) + 1)) = _
Application.WorksheetFunction.Transpose(varData)
.UsedRange.Columns.AutoFit
End With
Set sh = Nothing
Set wb = Nothing
End Sub