Hello,
We run an Access 2016 database to manage the parish and parishioner data for our local diocese. I've added an email function to the system so that we are able to output and send reports to each parish monthly.
It all runs fine but I've noticed that as the system generated the reports, it begins to slow down about halfway through. The first 50 or so parishes will export in a few seconds each, but by the back half of the recordset, it takes upwards to 30 seconds to export a single report. Is there something that I should be clearing at the end of each loop?
Thank you for any help!
<---------------------------------------------Code----------------------------------------------->
Sub ParishionerChangesReport()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim MinDate As String
'===Use form's textbox to set date range for data pull==='
MinDate = Me.TB_MinDate.Value
'===Fetch list of parishes with at least one change. These parishes will have a report generated==='
Set db = CurrentDb
Set qdf0 = db.QueryDefs("Parishioner_Changes_EmailRecipients")
qdf0.SQL = "SELECT DISTINCT z.Parish_No, PM.Parish_Name, PM.Parish_City FROM Parish_Master as PM Inner Join (SELECT D.AAA_ID, D.Parish_No FROM Donors AS D WHERE d.Change_Date >= #" & MinDate & "#) AS Z on PM.Parish_No = z.Parish_No"
Set rs = db.OpenRecordset("Parishioner_Changes_EmailRecipients")
Set qdf1 = db.QueryDefs("In House - Changes by Timeframe")
Set qdf2 = db.QueryDefs("In House - Parishioner Change Report")
'===Pull data on all parishioners that have changed since specified MinDate==='
qdf1.SQL = "SELECT d.AAA_ID, TRIM(d.Prefix &' '&d.First&' '&d.Last&' '&d.Suffix) as [Full Name], " _
& "TRIM([d.Address1]&iif(((d.Address2 is Null) or (d.Address2 not like '*[a-z]*')), ', ', ', '&d.Address2&', ')&d.City&', '&d.State&' '&d.Zip) as [Full Address], " _
& "PM.Parish_No, PM.Parish_Name, PM.Parish_City, d.ChangeCode, d.Change_Date, d.Last, c.Comments, c.Change_Date as [CommentDate], ('Changes made between ' & [Forms]![Frm_ReportEmail]![TB_MinDate] & ' AND ' & Date() & '') as [ChangeRange], " _
& "IIf([ChangeCode]='a','Added',(IIf([ChangeCode]='d','Deleted','Changed'))) AS ChangeCategory " _
& "FROM (Donors as D Inner Join Parish_Master as PM on d.Parish_NO = PM.Parish_NO) Left Join " _
& "(SELECT DC.Donor_ID, DC.Change_Date, DC.Change_Code, DC.Comments, DC.Deleted_By FROM Donor_Changes as DC WHERE (DC.Change_Date BETWEEN [Forms]![Frm_ReportEmail]![TB_MinDate] and Date()) and DC.Deleted_By Is Null) as C on d.ID = c.Donor_ID " _
& "WHERE d.Change_Date BETWEEN [Forms]![Frm_ReportEmail]![TB_MinDate] AND Date()"
'===Loop through parishes with at least one change and generate report==='
Do Until rs.EOF
qdf2.SQL = "SELECT * FROM [In House - Changes by Timeframe] WHERE [Parish_No] ='" & rs![Parish_No] & "'"
DoCmd.OutputTo acOutputReport, "In House - Parishioner Change Report", acFormatPDF, "M:\AAA\Export\In-House Report Exports\Parishioner Change Report-" & rs![Parish_No] & " - " & rs![Parish_Name] & "(" & Format(Date, "mm-dd-yyyy") & ").PDF"
rs.MoveNext
DoEvents
Loop
rs.Close
End Sub
<--------------------------------End of Code------------------------------------>
We run an Access 2016 database to manage the parish and parishioner data for our local diocese. I've added an email function to the system so that we are able to output and send reports to each parish monthly.
It all runs fine but I've noticed that as the system generated the reports, it begins to slow down about halfway through. The first 50 or so parishes will export in a few seconds each, but by the back half of the recordset, it takes upwards to 30 seconds to export a single report. Is there something that I should be clearing at the end of each loop?
Thank you for any help!
<---------------------------------------------Code----------------------------------------------->
Sub ParishionerChangesReport()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim MinDate As String
'===Use form's textbox to set date range for data pull==='
MinDate = Me.TB_MinDate.Value
'===Fetch list of parishes with at least one change. These parishes will have a report generated==='
Set db = CurrentDb
Set qdf0 = db.QueryDefs("Parishioner_Changes_EmailRecipients")
qdf0.SQL = "SELECT DISTINCT z.Parish_No, PM.Parish_Name, PM.Parish_City FROM Parish_Master as PM Inner Join (SELECT D.AAA_ID, D.Parish_No FROM Donors AS D WHERE d.Change_Date >= #" & MinDate & "#) AS Z on PM.Parish_No = z.Parish_No"
Set rs = db.OpenRecordset("Parishioner_Changes_EmailRecipients")
Set qdf1 = db.QueryDefs("In House - Changes by Timeframe")
Set qdf2 = db.QueryDefs("In House - Parishioner Change Report")
'===Pull data on all parishioners that have changed since specified MinDate==='
qdf1.SQL = "SELECT d.AAA_ID, TRIM(d.Prefix &' '&d.First&' '&d.Last&' '&d.Suffix) as [Full Name], " _
& "TRIM([d.Address1]&iif(((d.Address2 is Null) or (d.Address2 not like '*[a-z]*')), ', ', ', '&d.Address2&', ')&d.City&', '&d.State&' '&d.Zip) as [Full Address], " _
& "PM.Parish_No, PM.Parish_Name, PM.Parish_City, d.ChangeCode, d.Change_Date, d.Last, c.Comments, c.Change_Date as [CommentDate], ('Changes made between ' & [Forms]![Frm_ReportEmail]![TB_MinDate] & ' AND ' & Date() & '') as [ChangeRange], " _
& "IIf([ChangeCode]='a','Added',(IIf([ChangeCode]='d','Deleted','Changed'))) AS ChangeCategory " _
& "FROM (Donors as D Inner Join Parish_Master as PM on d.Parish_NO = PM.Parish_NO) Left Join " _
& "(SELECT DC.Donor_ID, DC.Change_Date, DC.Change_Code, DC.Comments, DC.Deleted_By FROM Donor_Changes as DC WHERE (DC.Change_Date BETWEEN [Forms]![Frm_ReportEmail]![TB_MinDate] and Date()) and DC.Deleted_By Is Null) as C on d.ID = c.Donor_ID " _
& "WHERE d.Change_Date BETWEEN [Forms]![Frm_ReportEmail]![TB_MinDate] AND Date()"
'===Loop through parishes with at least one change and generate report==='
Do Until rs.EOF
qdf2.SQL = "SELECT * FROM [In House - Changes by Timeframe] WHERE [Parish_No] ='" & rs![Parish_No] & "'"
DoCmd.OutputTo acOutputReport, "In House - Parishioner Change Report", acFormatPDF, "M:\AAA\Export\In-House Report Exports\Parishioner Change Report-" & rs![Parish_No] & " - " & rs![Parish_Name] & "(" & Format(Date, "mm-dd-yyyy") & ").PDF"
rs.MoveNext
DoEvents
Loop
rs.Close
End Sub
<--------------------------------End of Code------------------------------------>