[AccessD] Ac2013 running out of resources

[Bill Benson]

the SQL in the base query is

SELECT [User Information List].Office AS [Manager Office], [PDR
Tracking].[Tax Manager], [PDR Tracking].[Project Name], [PDR
Tracking].[Client Name], [PDR Tracking].[Tax Partner], IIf([Document
Type]="DDR, 100 Day Plan and Structuring","Y","") AS [DDR, 100 Day Plan and
Structuring], IIf([Document Type]="DDR and Structuring","Y","") AS [DDR and
Structuring], IIf([Document Type]="DDR and 100-Day Plan","Y","") AS [DDR
and 100-Day Plan], IIf([Document Type]="100 Day Plan and
Structuring","Y","") AS [100 Day Plan and Structuring], IIf([document
Type]="Due Diligence Report","Y","") AS [Due Diligence Report],
IIf([Document Type]="Structuring","Y","") AS Structuring, IIf([Document
Type]="100 Day Plan","Y","") AS [100 Day Plan]
FROM ([PDR Tracking] INNER JOIN [User Information List] ON [PDR
Tracking].[Tax Manager] = [User Information List].ID) INNER JOIN
tblCityRegion ON [User Information List].City = tblCityRegion.City
WHERE [Tax Manager] = 252 AND [Deal Status] LIKE "Signed*"  AND
tblCityRegion.Region="East" AND ([Sign Date] Between #5/31/2015# AND
#10/1/2014#) AND [PDR Tracking].[Tax Partner] Is Not Null
ORDER BY [User Information List].City, [PDR Tracking].[Tax Manager];



Note that I am changing the WHERE clause.

Also note that the main two tables [User Information List] and [PDR
Tracking] are Sharepoint Lists (linked).



On Thu, Jun 4, 2015 at 5:07 PM, Bill Benson <bensonforums at gmail.com> wrote:

> 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
>