Excel VBA Array is getting cleared every time a Subroutine is called

I am using Excel VBA to sort through a folder and it's subfolder to find the files that start with a specific name (in this case files called BACAPPC.xml). I am looking to save the name of that file to an array. Once I know where the file in located, there is another file in a related folder that I want to grab the name of and add it to the array. The code below finds that two file names and enters them into the array after the first BACAPPC.xml file is found), however when the DoFolder sub gets called again to search a new set of folders, it initializes the array and wipes the previous stored values.

Sub FindAllXMLinAUserSpecifiedFolder2()
' First ask user for the file path to search for the XML files

    Dim fldr As FileDialog
    Dim sItem As String
    ' temp comment out call dialog box and force path name
    sItem = "C:\UserData\hawkib\XXXX\YYYY\Job_10-18-22"
    
    'Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    'With fldr
    '    .Title = "Select a Folder"
    '    .AllowMultiSelect = False
    '    .InitialFileName = Application.DefaultFilePath
    '    If .Show <> -1 Then GoTo NextCode
    '    sItem = .SelectedItems(1)
    'End With
'NextCode:
    GetFolder = sItem
'    Set fldr = Nothing


' more stuff

    Dim FileSystem As Object
    Dim HostFolder As String
    
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    HostFolder = GetFolder
        
    DoFolder FileSystem.GetFolder(HostFolder), 1
End Sub
    
Sub DoFolder(folder, RowNum As Integer)
    Dim SubFolder
    Dim ExtSplit As Variant
    Dim NameSplit As Variant
    Dim TempName As String
    Dim TempFileName As String
    Dim file
    Dim AppFileLocs() As Variant
    Dim AppTypeInfoLocation As String
    Dim Split1 As Variant
    Dim Split2 As Variant
    
    For Each SubFolder In folder.SubFolders
    TempName = SubFolder
        If InStr(1, SubFolder, "TPL_", vbTextCompare) > 0 Then
    
    For Each file In SubFolder.Files
        TempFileName = file
        If file Like "*BAAPPC_*.xml" Then
                ' prints file to excel - for testing only
                ActiveSheet.Cells(RowNum, 1) = file
                ReDim Preserve AppFileLocs(RowNum - 1, 2)
                AppFileLocs(RowNum - 1, 0) = file
                 ExtSplit = Split(file, ".")
                 NameSplit = Split(file, "\")

                 Flpath = Left(file, Len(file) - Len(NameSplit(UBound(NameSplit))))
                Spilt1 = Split(Flpth, "\")
                ' find name of parent folder and then append to change directory to parent folder\APPTYPE then include name of file that will be added to the array
                Split1 = Left(SubFolder, InStrRev(SubFolder, "\") - 1) & "\APPTYPE\AppTypeInfo.xml"
                AppFileLocs(RowNum - 1, 1) = Split1
                
                
                RowNum = RowNum + 1
        End If
    Next
        End If
        
        DoFolder SubFolder, RowNum
    Next


End Sub

Any suggestions on how to allow the search to go through all folders and subfolders and add the file names to an array?

Here's one way, using a non-recursive search over subfolders, then processing the list of found files:

Option Explicit

Sub Tester()

    Dim xmlFiles As Collection, rootFolder As String, xmlFile, appFileLocs As Collection
    
    rootFolder = "C:\UserData\hawkib\XXXX\YYYY\Job_10-18-22"
    
    Set xmlFiles = GetFileMatches(rootFolder, "*BAAPPC_*.xml")
    Set appFileLocs = New Collection
    
    For Each xmlFile In xmlFiles
        Debug.Print xmlFile.Path
        appFileLocs.Add xmlFile.parentfolder.Path & "\APPTYPE\AppTypeInfo.xml"
    Next xmlFile
    
    'do something with `appFileLocs`

End Sub

'Return a collection of file objects given a starting folder and a file pattern
'  e.g. "*.txt"
'Pass False for last parameter if don't want to check subfolders
Function GetFileMatches(startFolder As String, filePattern As String, _
                    Optional subFolders As Boolean = True) As Collection

    Dim fso, fldr, f, subFldr, fpath
    Dim colFiles As New Collection
    Dim colSub As New Collection

    Set fso = CreateObject("scripting.filesystemobject")
    colSub.Add startFolder

    Do While colSub.Count > 0

        Set fldr = fso.getfolder(colSub(1))
        colSub.Remove 1
        'collect any subfolders
        If subFolders Then
            For Each subFldr In fldr.subFolders
                colSub.Add subFldr.Path
            Next subFldr
        End If
        '### collect any matching files only if the folder name contains "TPL_"
        If InStr(1, fldr.Name, "TPL_", vbTextCompare) > 0 Then
            For Each f In fldr.Files
                If f.Name Like filePattern Then colFiles.Add f
            Next f
        End If
    Loop
    Set GetFileMatches = colFiles
End Function

Loop Through Folders of Folders of a Folder

• Since you know the depth level of the folders you need, you can avoid using recursion or other methods to find all subfolders of a folder.
• Since you have access to the FileSystemObject object, you also have access to the Dictionary object. It is a more appropriate data structure to be used instead of an array.

<!-- language: lang-vb -->

Sub GetXmlFilePairs()
Const ROOT_FOLDER_PATH As String _
= "C:\UserData\hawkib\XXXX\YYYY\Job_10-18-22"
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
' Each key will contain the 'baappc...' file path while each corresponding
' item will contain the 'AppTypeInfo.xml' file path.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim fsoFolder As Object, fsoSubFolder As Object, fsoFile As Object
Dim SubFolderPath As String, SubFilePath As String
' Level 1: all folders of the root folder
For Each fsoFolder In fso.GetFolder(ROOT_FOLDER_PATH).Subfolders
' Level 2: all folders of all folders of the root folder
For Each fsoSubFolder In fsoFolder.Subfolders
If InStr(1, fsoSubFolder.Name, "TPL_", vbTextCompare) > 0 Then ' contains
'If InStr(1, fsoSubFolder.Name, "TPL_", vbTextCompare) = 1 Then ' begins with
SubFolderPath = fsoSubFolder.Path
For Each fsoFile In fsoSubFolder.Files
If LCase(fsoFile.Name) Like "baappc_*.xml" Then ' begins with / ends with
'If LCase(fsoFile.Name) Like "*baappc_*.xml" Then ' contains / ends with
SubFilePath = fso _
.BuildPath(SubFolderPath, "APPTYPE\AppTypeInfo.xml")
If fso.FileExists(SubFilePath) Then
dict(fsoFile.Path) = SubFilePath
Else
dict(fsoFile.Path) = ""
End If
' If you're looking for a single file per folder
' (looks like it), you could improve efficiency with:
'Exit For
End If
Next fsoFile
End If
Next fsoSubFolder
Next fsoFolder
If dict.Count = 0 Then
MsgBox "No files found.", vbExclamation
Exit Sub
End If
' Print the paths of the file pairs in the Immediate window ('Ctrl+G').
Dim Key
For Each Key In dict.Keys
Debug.Print Key, dict(Key)
Next Key
' Return the paths of the file pairs in a worksheet.
'    With ActiveSheet.Range("A2").Resize(dict.Count)
'        .Value = Application.Transpose(dict.Keys)
'        .Offset(, 1).Value = Application.Transpose(dict.Items)
'    End With
' Note that this simplification wouldn't be possible
' if you used a collection instead of the dictionary.
End Sub