For Each Loop works once then gives error 91 2

With [red]xlApp[/red]
    ...[blue]
    .Cells(2, 1).[/blue]CopyFromRecordset rs
    ...
End With

Case "Submittal Data"
                    .Cells(2, 1).CopyFromRecordset rs
                    [highlight #FCE94F]Debug.Print ActiveWorkbook.Name[/highlight]
                    Debug.Print ActiveWorkbook.PivotCaches.Count
                    For Each chPivot In ActiveWorkbook.PivotCaches
                        chPivot.Refresh
                    Next chPivot
                    .Range("H2:H" & lastRow + 1).ClearContents
            End Select

Function FormatExcel_Recordset(filename As String, qry As String, Optional Customize As String)
'Output data to excel and apply existing
'format of the "template" which may include
'conditional formatting
'20181204
'refresh pivot table and chart
'[URL unfurl="true"]https://www.automateexcel.com/vba/refresh-pivot-tables/[/URL]
'20230828
'change the where clause for data to > 0
'20230828
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim stsql As String
    Dim objapp As Object
    Dim wb As Object
    Dim ws As Object
    Dim Rng As Object
    Dim stCustomize As String
    Dim stMgr As String
    Dim stDiscShort As String
    Dim stCol As String
    Dim lastRow As Integer
    Dim lastCol As Integer
    Dim fname As Variant
    Dim FNameExists As Boolean
    Dim chPivot As PivotCache
    Dim i As Integer
    Dim yesno
    
    Set objapp = CreateObject("Excel.Application")     'Excel Not Running
    
    objapp.Visible = True
    Set wb = objapp.Workbooks.Open(filename, True, False)
    
    If Len(Customize) > 0 Then
        stCustomize = FileNameNoExt(Customize)
    End If
    
    For Each ws In wb.Worksheets
        'Debug.Print ws.Name
        With ws
            .Activate
            Set rs = CurrentDb.OpenRecordset(qry)   'qryLetters_Excel
            
            rs.MoveLast
            rs.MoveFirst
            
            lastRow = rs.RecordCount + 1
            lastCol = .Range("A1").CurrentRegion.Columns.Count
            Select Case ws.Name
                Case "Summary"
                    'Insert rows to push total row to end without overwriting
                    .Range("3:" & lastRow + 1 & "").EntireRow.Insert
                    .Cells(3, 1).CopyFromRecordset rs
                    .Range("E2:F2").Copy
                    'paste formula for difference and percent
                    .Range("E2:F" & lastRow + 1).PasteSpecial xlPasteAll
                    .Application.CutCopyMode = False
                    'Apply format to all data rows
                    .Range("A2:F2").Copy
                    .Range("A2:F" & lastRow + 1).PasteSpecial xlPasteFormats
                    .Application.CutCopyMode = False
                    'Remove demo row which format was based upon
                    .Rows(2).Delete
                    'For second loop, change query to allow pasting of detail rows
                    qry = "qryOverDueOutstandingList_ExportData"
                Case "Data"
                    Set qd = EditQryDef(qry)
                    stsql = Replace(qd.SQL, "ORDER BY ", "WHERE DisciplineLeadData.DaysLate > 0 ORDER BY ")
                    Set rs = CurrentDb.OpenRecordset(stsql)
                    .Cells(2, 1).CopyFromRecordset rs
                    .Range("H2:H" & lastRow + 1).ClearContents
                Case "Submittal Data"
                    .Cells(2, 1).CopyFromRecordset rs
                    Debug.Print ActiveWorkbook.Name
                    Debug.Print ActiveWorkbook.PivotCaches.Count
                    For Each chPivot In ActiveWorkbook.PivotCaches
                        chPivot.Refresh
                    Next chPivot
                    .Range("H2:H" & lastRow + 1).ClearContents
            End Select
            .Range("A1").Select
        End With
        lastRow = 0
        lastCol = 0
    Next
    
exit_function:
    wb.Worksheets(1).Activate
    'prepopulate file name so user knows whether this
    'is a course or conference spreadsheet.  Name can
    'be modified to another name as appropriate
    '20160405
    If stCustomize <> "ResponsesToJPBLetters" Then
        Customize = Replace(Customize, ".xlsx", Format(Date, "_yyyymmdd") & ".xlsx")
        Customize = Replace(Customize, "-", "_")
    End If
    If stCustomize = "" Then
        Customize = Replace(Replace(filename, ".xlsx", Format(Date, "_yyyymmdd") & ".xlsx"), "Template_", "")
        Customize = Replace(Customize, "Documents\ExcelFiles", "Downloads")
    End If
    FNameExists = False
fnameSave:
    Do While FNameExists = False
        
        fname = GetSaveFilename(Customize)
fnameReplace:
        If fname = "" Then
            'no file chosen or user hit cancel
            '20170612
            Exit Do
        ElseIf Dir(fname) = "" Then
            wb.SaveAs fname, FileFormat:=51
            FormatExcel_Recordset = fname
            FNameExists = True
        ElseIf fname = False Then
            MsgBox "File will not be saved", vbOKOnly + vbInformation, "Cancel SaveAs"
            wb.Close savechanges:=False
            
            FNameExists = True
        Else
            objapp.Visible = False
            yesno = MsgBox("File " & fname & " already exists.  Would you like to REPLACE this file? " & vbCrLf & vbCrLf & "Press No to choose another name; Cancel to quit without saving.", vbYesNoCancel, "File Exists")
            objapp.Visible = True
            If yesno = vbCancel Then
                wb.Close savechanges:=False
                FNameExists = True
            ElseIf yesno = vbYes Then
                Kill fname
                GoTo fnameReplace
            Else
                GoTo fnameSave
            End If
        End If
    Loop
    rs.Close
    Set rs = Nothing
    Set qd = Nothing
    objapp.Quit
    Set chPivot = Nothing
    Set objapp = Nothing
End Function

With objapp
    ...
End With

[COLOR=blue]Option Compare Database
Option Explicit

Public ActiveWorkbook As Object

' Early or late binding makes no difference to this
Public Sub Demo()
    Set ActiveWorkbook = CreateObject("Excel.Application").workbooks.Add [COLOR=green]' possibly in some startup code somewhere, so only run once[/color]
       
    minimalexample
    
    ActiveWorkbook.Close
    Set ActiveWorkbook = Nothing [COLOR=green]' possibly in some cleanup code, but this can be run multiple times without error, so could happily sit ion your main processing loop[/color]
    
    minimalexample
     
End Sub

Public Sub minimalexample()
    Dim objapp As Object
    Set objapp = CreateObject("Excel.Application")
    Debug.Print ActiveWorkbook.Name
End Sub[/color]

Case "Submittal Data"
    .Cells(2, 1).CopyFromRecordset rs
    [highlight #FCE94F]Debug.Print [blue]objapp.[/blue]ActiveWorkbook.Name[/highlight]
    ...

Sub test()
Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
' Application.Activate
MsgBox ActiveWorkbook.Name
objExcel.Quit
Set objExcel = Nothing
End Sub

Case "Submittal Data"
    .Cells(2, 1).CopyFromRecordset rs
    Debug.Print objapp.ActiveWorkbook.Name
    Debug.Print objapp.ActiveWorkbook.PivotCaches.Count
    For Each chPivot In [highlight #73D216]objapp.[/highlight]ActiveWorkbook.PivotCaches
        chPivot.Refresh
    Next chPivot
    .Range("H2:H" & lastRow + 1).ClearContents
End Select

'Adjust the range for the pivot table and refresh
    'Since this is from an excel file being used like a template, we know there is only
    'one pivot table as well as the sheet and range which
    'is why that is hard coded in the replace statement as R663
    'otherwise, would need to further identify the sheet, the
    'pivottable name and the range in order not to change the
    'source data of multiple pivots.  
'Found the range via chPivot.SourceData
    '20230829
    For Each chPivot In objapp.ActiveWorkbook.PivotCaches        
        chPivot.SourceData = Replace(chPivot.SourceData, "R663", "R" & lastRow)
        chPivot.Refresh
    Next chPivot