Getting out of memory error when looping through folders and subfolders

[RLG_1204]

Can someone please help me. I am new to VBA coding and I have been stuck on this code for a while now. I am trying to get connection string information on XLSM files that are located in folders and sub folders of a directory. When I ran the code, everything seemed to run fine, but then I got an "out of memory" error. As I was trying to fix this error, I was also getting a "method rows of object_global failed" run time error. At this point I am not sure how to fix the code. I would appreciate anyone's help this. thank you.

[SIZE=1]Sub ListFiles()
    Dim sRoot       As String
    Dim oFSO        As Scripting.FileSystemObject
 
    sRoot = Sheet1.Range("A1")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
   
    Sheet1.Columns.Range("A3:F10000").ClearContents
    Sheet1.Range("A:F").ColumnWidth = 50
    Sheet1.Range("A3:F5000").RowHeight = 50
   
    Set oFSO = New Scripting.FileSystemObject
    RecurseFolder oFSO, sRoot, True
       
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub
 
Sub RecurseFolder(oFSO As FileSystemObject, sDir As String, IncludeSubFolders As Boolean)
    Dim oFil        As File
    Dim oFld        As Folder
    Dim oSub        As Folder
    Dim iRow        As Long
    Dim Wb          As Workbook
    Dim Cn          As WorkbookConnection
    Dim StrFile     As String
    Dim StrFilePath As String
   
   
    iRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
    Set oFld = oFSO.GetFolder(sDir)
    Set Wb1 = ActiveWorkbook
      
      For Each oFil In oFld.Files
      With oFil
            If oFil.Type = "Microsoft Excel Macro-Enabled Worksheet" Then
            On Error Resume Next
            Set Wb = GetObject(oFil.Path)
            DoEvents
            On Error GoTo 0
               
                With Cn
                    For Each Cn In Wb.Connections
                       If Cn.Type = xlConnectionTypeOLEDB Then
                       Rows(iRow).Range("A1:F1").Value = Array(oFld.Path, oFil.Name, Cn.Name, Cn.OLEDBConnection.SourceDataFile, _
                                                            Cn.OLEDBConnection.Connection, Cn.OLEDBConnection.CommandText)
                       ElseIf Cn.Type = xlConnectionTypeODBC Then
                          Rows(iRow).Range("A1:F1").Value = Array(oFld.Path, oFil, Name, Cn.Name, Cn.ODBCConnection.SourceDataFile, _
                                                            Cn.ODBCConnection.Connection, Cn.ODBCConnection.CommandText)
                       End If
                                       
                    iRow = iRow + 1
                    Next Cn
                 
                End With
                 
                    Wb.Close Saved = True
                    DoEvents
                    Set Wb = Nothing
                 
            End If
      End With
           
      
    Next oFil
 
    If IncludeSubFolders Then
        For Each oSub In oFld.SubFolders
            RecurseFolder oFSO, oSub.Path, True
           
        Next oSub
    End If
   
End Sub[/SIZE]