[AccessD] Ac2013 running out of resources

[Bill Benson]

I have the following routine. Access is running out of resources after
about the 60th item in the resordset (Rst). I can't understand why, since I
keep updating the SQL of the same querydef, on which the (very simply)
report is based, and am outputting to PDF. It happens even if I remove the
insertion logic below the reporting output logic.

Any experience and assistance would be very greatly appreciated.


Sub DoManagerReportsWest(strStartDate As String, strEndDate As String,
Optional FY)
Dim DB As dao.Database
Dim SQL As String
Dim QDF As dao.QueryDef
Dim rst As dao.Recordset
Dim SQL1 As String
Dim FLD As Folder
Dim FSO As FileSystemObject
Dim strPath As String
Dim rstTest As dao.Recordset
Dim SQLInsert As String
Dim strReportPath As String
Dim SQLDelete As String
Set DB = CurrentDb
Set FSO = New FileSystemObject
strPath = Left(DB.Name, InStrRev(DB.Name, "\") - 1)
On Error Resume Next
Set FLD = FSO.GetFolder(strPath & "\Reports\" & Format(Date, "Mmm dd"))
If FLD Is Nothing Then
    Set FLD = FSO.GetFolder(strPath & "\Reports")
    If FLD Is Nothing Then
        Set FLD = FSO.CreateFolder(strPath & "\Reports")
    End If
    On Error GoTo 0
    Set FLD = Nothing
    Set FLD = FSO.CreateFolder(strPath & "\Reports\" & Format(Date, "Mmm
dd"))
End If
If FLD Is Nothing Then
    MsgBox "Cannot output reports to disk - aborting"
    Exit Sub
End If
SQL = "SELECT DISTINCT B.ID, B.Name AS [Engagement Manager], B.[first Name]
as FirstName, B.Email FROM ([User Information List] AS B INNER JOIN [PDR
Tracking] AS A ON B.[ID] = A.[Tax Manager]) LEFT JOIN tblCityRegion ON
B.City = tblCityRegion.City WHERE tblCityRegion.Region=""West"""
Set rst = DB.OpenRecordset(SQL)
If Not rst.EOF Then
    strPath = FLD.Path

    Do
        Set QDF = DB.QueryDefs("Deliverables by Eng Manager")
        SQL1 = QDF.SQL
        SQL1 = Left(SQL1, InStr(SQL1, "WHERE ") - 1)
        SQL1 = SQL1 & " WHERE [Tax Manager] = " & rst.Fields(0) & " AND
[Deal Status] LIKE ""Signed*"" "
        SQL1 = SQL1 & " AND tblCityRegion.Region=""West"""
        SQL1 = SQL1 & " AND ([Sign Date] Between #" & strStartDate & "# AND
#" & strEndDate & "#"
        If Not IsMissing(FY) Then
            SQL1 = SQL1 & " AND NZ([Fiscal Year],'" & CStr(FY) & "') = '" &
CStr(FY) & "')"
        Else
            SQL1 = SQL1 & ")"
        End If
        SQL1 = SQL1 & " AND [PDR Tracking].[Tax Partner] Is Not Null "
        SQL1 = SQL1 & " ORDER BY [User Information List].City Asc, [PDR
Tracking].[Tax Manager] Asc;"
        Set rstTest = Nothing
        Set rstTest = DB.OpenRecordset(SQL1)
        If Not rstTest.EOF Then
            QDF.SQL = SQL1
            DB.QueryDefs.Refresh: Set QDF = Nothing
            strReportPath = strPath & "\" & Replace$(rst.Fields(1), "/", "
") & "_Deliverables By Manager (West) Signed " &
Format(CDate(strStartDate), "yyyy_mm_dd") & " to " &
Format(CDate(strEndDate), "yyyy_mm_dd") & ".pdf"

            On Error Resume Next
            Kill strReportPath
            On Error GoTo 0
            DoCmd.OutputTo acOutputReport, "rptDeliverableManager",
acFormatPDF, strReportPath

            SQLDelete = "Delete From tblBatchReports "
            SQLDelete = SQLDelete & " Where "
            SQLDelete = SQLDelete & " ReportName = 'Deliverables By Manager
(West)'"
            SQLDelete = SQLDelete & " AND SignDateBegin = #" & strStartDate
& "#"
            SQLDelete = SQLDelete & " AND SignDateEnd = #" & strEndDate &
"#"
            SQLDelete = SQLDelete & " AND Employee = '" &
rst.Fields("Engagement Manager") & "'"
            SQLDelete = SQLDelete & " AND Sent IS NULL"
            CurrentDb.Execute SQLDelete, dbFailOnError

            SQLInsert = "Insert Into TblBatchReports
(ReportName,SignDateBegin,SignDateEnd,CreateDate,ReportPath,Employee,FirstName,EmailAddress)"
            SQLInsert = SQLInsert & " Values ('Deliverables By Manager
(West)',"
            SQLInsert = SQLInsert & "#" & strStartDate & "#,"
            SQLInsert = SQLInsert & "#" & strEndDate & "#,"
            SQLInsert = SQLInsert & "#" & Format(Date, "m/d/yyyy") & "#,"
            SQLInsert = SQLInsert & "'" & strReportPath & "',"
            SQLInsert = SQLInsert & "'" & rst.Fields("Engagement Manager")
& "',"
            SQLInsert = SQLInsert & "'" & rst.Fields("FirstName") & "',"
            SQLInsert = SQLInsert & "'" & rst.Fields("Email") & "')"
            DB.Execute SQLInsert, dbFailOnError
        End If
        rst.MoveNext
    Loop Until rst.EOF
End If
End Sub