Redim preserve array on recursive sub

Question

I'm having issues populating a list box with an array on a recursive sub that looks for files in multiple subfolders. I initially was populating it locally inside the Sub confListFiles but it would overwrite the array on the next iteration of the Sub. I changed the integer to public to keep the count from resetting to zero but now getting "Subscript out of range error". Any help on this is greatly appreciated and please excuse my lack of VBA knowledge and arrays.

Public j As Integer (In Module)

Sub getConf()
Dim firstFolder, confSearchWord As String
Set FSC = CreateObject("Scripting.FileSystemObject")

confSearchWord = dwgText1.Value
j = 0

dataSplit = Split(confSearchWord, "-")
firstFolder = dataSplit(0)
folderName = folderName & "\" & firstFolder '(folderName > In Module)

If FSC.FolderExists(folderName) Then
    Set confFldStart = FSC.GetFolder(folderName)
    confListFolders confFldStart, confSearchWord
Else
    MsgBox "NO FOLDER EXISTS"
End If

End Sub


Sub confListFolders(confFldStart As Object, confSearchWord As String)
Dim conffld As Object
         
For Each conffld In confFldStart.SubFolders
    
        DoEvents
        If stopCode = True Then
            Exit For
            Exit Sub
        End If
                            
        confListFiles conffld, confSearchWord
        confListFolders conffld, confSearchWord
        
    Next

End Sub

Sub confListFiles(conffld As Object, confSearchWord As String)
    Dim fl As Object, FCC As Object
    Dim i As Integer
    Dim strFind As String
    Dim confList() As Variant
            
    Set FCC = CreateObject("Scripting.FileSystemObject")
       
    If conffld.Files.Count <> 0 Then
        ReDim confList(1 To conffld.Files.Count, 1 To 3)
    End If
    
    For Each fl In conffld.Files
    
        DoEvents
        If stopCode = True Then
            Exit For
            Exit Sub
        End If
                              
        If InStr(fl.Name, confSearchWord) Then
            j = j + 1
            confList(j, 1) = fl.Name
            confList(j, 2) = FCC.GetExtensionName(LCase(fl))
            confList(j, 3) = fl.path

            With list2
                .ColumnCount = 2
                .ColumnWidths = "146;20"
                .List = confList
            End With
            
        End If
    Next fl
End Sub

I initially was populating it locally inside the Sub confListFiles but it would overwrite the array on the next iteration of the Sub.

Answer 1

Return File Properties in a List Box

Main

Sub PopulateListBox()
    
    Const ROOT_FOLDER As String = "C:\Test"
    
    ' Reference the 'FileSystemObject' object once.
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Retrieve the search text.
    Dim SearchText As String: SearchText = dwgText1.Value
     
    ' Build the folder path.
    Dim FolderName As String: FolderName = Split(SearchText, "-")(0)
    Dim FolderPath As String:
    FolderPath = fso.BuildPath(ROOT_FOLDER, FolderName)
    
    ' Exit if folder path doesn't exist.
    If Not fso.FolderExists(FolderPath) Then
        MsgBox "The folder path """ & FolderPath & """ doesn't exist!", _
            vbExclamation
        Exit Sub
    End If
    
    ' Return the matching files in a collection.
    Dim coll As Collection: Set coll = New Collection
    FilesToCollection fso.GetFolder(FolderPath), SearchText, coll
    
    ' Return the required file data in a 2D one-based array.
    Dim Data() As String: ReDim Data(1 To coll.Count, 1 To 3)
    Dim fsoFile As Object, i As Long
    For Each fsoFile In coll
        i = i + 1
        Data(i, 1) = fsoFile.Name
        Data(i, 2) = fso.GetExtensionName(fsoFile)
        Data(i, 3) = fsoFile.Path
    Next fsoFile

    ' Populate the list box with the file data.
    With list2
        .ColumnCount = 3
        .ColumnWidths = "146;40;250"
        .List = Data
    End With

End Sub

Help

Sub FilesToCollection( _
        ByVal fsoFolder As Object, _
        ByVal SearchText As String, _
        ByRef coll As Collection)
    Dim fsoSubFolder As Object, fsoFile As Object
    For Each fsoSubFolder In fsoFolder.Subfolders
        FilesToCollection fsoSubFolder, SearchText, coll
    Next fsoSubFolder
    For Each fsoFile In fsoFolder.Files
        ' Determine which files to collect.
        If InStr(1, fsoFile.Name, SearchText, vbTextCompare) > 0 Then ' contains
            coll.Add fsoFile
        End If
    Next fsoFile
End Sub