[AccessD] Ac2013 running out of resources

[Jim Dettman]

Bill,


See if the below runs any better.

Jim.


Sub DoManagerReportsWest(strStartDate As String, strEndDate As String,
Optional prmFiscalYear)

    Dim CurDB As dao.Database
    Dim objFSOFolder As Folder
    Dim objFSO As FileSystemObject
    Dim strPath As String
    Dim strReportPath As String

    Dim qrydef As dao.QueryDef
    Dim rst As dao.Recordset
    Dim rstTest As dao.Recordset

    Dim strSQL As String
    Dim strSQLqryDef As String
    Dim steSQLInsert As String
    Dim strSQLDelete As String

    On Error GoTo DoManagerReportsWest_Error

    ' Make sure we have a report folder.  If not, try and create it.
    Set CurDB = CurrentDb
    Set objFSO = New FileSystemObject
    strPath = left(CurDB.Name, InStrRev(CurDB.Name, "\") - 1)
    
    On Error Resume Next
    
    Set objFSOFolder = objFSO.GetFolder(strPath & "\Reports\" & Format(Date,
"Mmm dd"))

    If objFSOFolder Is Nothing Then
        Set objFSOFolder = objFSO.GetFolder(strPath & "\Reports")
        If objFSOFolder Is Nothing Then
            Set objFSOFolder = objFSO.CreateFolder(strPath & "\Reports")
        End If
        On Error GoTo DoManagerReportsWest_Error
        Set objFSOFolder = objFSO.CreateFolder(strPath & "\Reports\" &
Format(Date, "Mmmdd "))
    End If

    ' If we don't have a folder, no sense running the reports.
    If objFSOFolder Is Nothing Then
        MsgBox "Cannot output reports to disk - aborting"
    Else
        strPath = objFSOFolder.Path
        Set objFSOFolder = Nothing

        ' Get the reports to run.
        strSQL = "SELECT DISTINCT B.ID, B.Name AS [Engagement Manager],
B.[first Name] as FirstName, B.Email"
        strSQL = strSQL & " FROM ([User Information List] AS B INNER JOIN
[PDRTracking] AS A ON B.[ID] = A.[Tax Manager])"
        strSQL = strSQL & " LEFT JOIN tblCityRegion ON B.City =
tblCityRegion.City WHERE tblCityRegion.Region='West'"

        Set rst = CurDB.OpenRecordset(strSQL)

        Do Until rst.EOF
            ' Generate the SQL required for the report.
            Set qrydef = CurDB.QueryDefs("Deliverables by Eng Manager")
            
            strSQLqryDef = qrydef.SQL
            strSQLqryDef = left(strSQLqryDef, InStr(strSQLqryDef, "WHERE ")
- 1)
            strSQLqryDef = strSQLqryDef & " WHERE [Tax Manager] = " &
rst.Fields(0).Value & " AND [Deal Status] LIKE 'Signed*' "
            strSQLqryDef = strSQLqryDef & " AND tblCityRegion.Region='West'"
            strSQLqryDef = strSQLqryDef & " AND ([Sign Date] Between #" &
strStartDate & "# AND #" & strEndDate & "#"

            If Not IsMissing(prmFiscalYear) Then
                strSQLqryDef = strSQLqryDef & " AND NZ([Fiscal Year],'" &
CStr(prmFiscalYear) & "') = '" & CStr(prmFiscalYear) & "')"
            Else
                strSQLqryDef = strSQLqryDef & ")"
            End If

            strSQLqryDef = strSQLqryDef & " AND [PDR Tracking].[Tax Partner]
Is Not Null "
            strSQLqryDef = strSQLqryDef & " ORDER BY [User Information
List].City Asc, [PDRTracking].[Tax Manager] Asc;"

            qrydef.SQL = strSQLqryDef
            qrydef.Close
            Set qrydef = Nothing

            Set rstTest = CurDB.OpenRecordset(strSQLqryDef)

            If Not rstTest.EOF Then
                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 DoManagerReportsWest_Error

                DoCmd.OutputTo acOutputReport, "rptDeliverableManager",
acFormatPDF, strReportPath

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

                steSQLInsert = "Insert Into
TblBatchReports(ReportName,SignDateBegin,SignDateEnd,CreateDate,ReportPath,E
mployee,FirstName,EmailAddress)"
                steSQLInsert = steSQLInsert & " VALUES ('Deliverables By
Manager (West)',"
                steSQLInsert = steSQLInsert & "#" & strStartDate & "#,"
                steSQLInsert = steSQLInsert & "#" & strEndDate & "#,"
                steSQLInsert = steSQLInsert & "#" & Format(Date, "m/d/yyyy")
& "#,"
                steSQLInsert = steSQLInsert & "'" & strReportPath & "',"
                steSQLInsert = steSQLInsert & "'" & rst.Fields("Engagement
Manager") & "',"
                steSQLInsert = steSQLInsert & "'" & rst.Fields("FirstName")
& "',"
                steSQLInsert = steSQLInsert & "'" & rst.Fields("Email") &
"')"
                CurDB.Execute steSQLInsert, dbFailOnError
            End If

            rstTest.Close
            Set rstTest = Nothing

            rst.MoveNext
        Loop
    End If

DoManagerReportsWest_Exit:
    On Error Resume Next

    rstTest.Close
    Set rstTest = Nothing

    qrydef.Close
    Set qrydef = Nothing

    rst.Close
    Set rst = Nothing

    Exit Sub

DoManagerReportsWest_Error:
    MsgBox "Unexpected Error: " & vb.Err
    Resume DoManagerReportsWest_Exit

End Sub

-----Original Message-----
From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of
Bill Benson
Sent: Thursday, June 04, 2015 05:07 PM
To: Access Developers discussion and problem solving
Subject: [AccessD] Ac2013 running out of resources

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.

<<snip>>
-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com