Help with my VBA code to send individua report to multiple recipients

[Stacey1306]

Hello,

I have created the following code (copied the code) and it works great. I have 2 problems with it namely; 1. all recipients get all reports and 2. I have the annoying Allow Deny when clicking on the command send button.

Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("qryEmailInvoices", dbOpenDynaset)
rs.MoveFirst
Do
vMemberID = rs("MemberID")
DoCmd.SendObject acSendReport, "Email Invoices", "PDFFormat(*.pdf)", rs("Email Address"), "", "", "Northern Beaches Liquor Accord Membership", "Please find attached your invoice to renew your annual Membership", False
rs.MoveNext
Loop Until rs.EOF
rs.Close
db.Close
End Sub

I need help please.
Cheers
Stacey

 

[dhookom]

I would use a little DAO code to change the SQL property of the record source query for the report inside the loop.
Assuming the report is based on the query named [qselEmailInvoice] your code might look something like:

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL as String
Dim qd As DAO.QueryDef

Set db = CurrentDb
Set rs = db.OpenRecordset("qryEmailInvoices", dbOpenDynaset)
Set qd = db.QueryDefs("qselEmailInvoice")
rs.MoveFirst
Do
	vMemberID = rs("MemberID")
	strSQL = "SELECT MemberID, InvoiceID, [Email Address], LastName, FirstName, .... " & _
		"FROM tblMembers JOIN tblInvoices ON .... " & _
		"WHERE MemberID = " & vMemberID
	DoCmd.SendObject acSendReport, "Email Invoices", "PDFFormat(*.pdf)", rs("Email Address"), _
              "", "", "Northern Beaches Liquor Accord Membership", _
              "Please find attached your invoice to renew your annual Membership", False
	rs.MoveNext
Loop Until rs.EOF
rs.Close
SET rs = Nothing
SET db = Nothing

To avoid the "Allow Deny" consider using Redemption.

Duane
Hook'D on Access
MS Access MVP

 

[Andrzejek]

I have the annoying Allow Deny when clicking on the command send button"

Have you considered adding Microsoft CDO for Windows 2000 Library and use CDO to send e-mails with attachements?
You can find many examples of how to do it here at TT

Have fun.

---- Andy

 

[Stacey1306]

Hello Duane,

Thank you for replying to my query, I will try out your revised code. I am new to the forum and as I am in Australia, apologies for not being able to reply quickly due to time zone.

Again thanks to all who are offering me solutions, as I have been searching and researching online for a number of weeks now, and need to get the dbase finished soon.

I have tried redemption however did not work to stop the annoying Allow / Deny and I have also tried changing my Outlook settings to no avail - I have tried Yes Click which didn't work either - very strange ?

Will post back as soon as I have had my wheetbix its 7:30am here.

Cheers
Stacey

 

[Stacey1306]

Hello Duane,

Decided to forgo the wheetbix and start coding this morning. I replaced your code and got the following error message "3265" item not found in the collection and I do not know anything about set qd - appreciate your help.

Dim strSQL As String
Dim qd As DAO.QueryDef

Set db = CurrentDb
Set rs = db.OpenRecordset("qryEmailInvoices", dbOpenDynaset)
#Set qd = db.QueryDefs("qselEmailInvoice")
rs.MoveFirst
Do
vMemberID = rs("MemberID")
strSQL = "SELECT MemberID, InvoiceID, [Email Address], LastName, FirstName, .... " & _
"FROM tblMembers JOIN tblInvoices ON .... " & _
"WHERE MemberID = " & vMemberID
DoCmd.SendObject acSendReport, "Email Invoices", "PDFFormat(*.pdf)", rs("Email Address"), _
"", "", "Northern Beaches Liquor Accord Membership", _
"Please find attached your invoice to renew your annual Membership", False
rs.MoveNext
Loop Until rs.EOF
rs.Close
Set rs = Nothing
Set db = Nothing

 

[dhookom]

Stacey1306,
Sorry, I forgot a significant line in the code. Is your query named qryEmailInvoices? What is the actual SQL view of your query?

The code I provided changes the SQL view of the query that is the report's record source and then sends the email.

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL as String
Dim qd As DAO.QueryDef

Set db = CurrentDb
Set rs = db.OpenRecordset("qryEmailInvoices", dbOpenDynaset)
[COLOR=#4E9A06]' qselEmailInvoice is the name of your query that is the record source of your report[/color]
Set qd = db.QueryDefs("qselEmailInvoice")
rs.MoveFirst
Do
	vMemberID = rs("MemberID")
	[COLOR=#4E9A06]'strSQL is the SQL view of qselEmailInvoice[/color]
	strSQL = "SELECT MemberID, InvoiceID, [Email Address], LastName, FirstName, .... " & _
		"FROM tblMembers JOIN tblInvoices ON .... " & _
		"WHERE MemberID = " & vMemberID
	[COLOR=#EF2929]qd.SQL = strSQL[/color]   [COLOR=#4E9A06]'forgot this line[/color]
	DoCmd.SendObject acSendReport, "Email Invoices", "PDFFormat(*.pdf)", rs("Email Address"), _
              "", "", "Northern Beaches Liquor Accord Membership", _
              "Please find attached your invoice to renew your annual Membership", False
	rs.MoveNext
Loop Until rs.EOF
rs.Close
SET rs = Nothing
SET db = Nothing

Duane
Hook'D on Access
MS Access MVP

 

[Stacey1306]

Hi Duane,

Thanks and my query name is qryEmailInvoices that both the form and the report relate to - I changed Set qd = db.QueryDefs("qselEmailInvoice")
to read Set qd = db.QueryDefs("qryEmailInvoices") and I fixed the error message, however the email just hangs now.

Stacey

 

[Stacey1306]

Update .... After renaming qselEmailInvoice my emails did go however the report is still not looping and the recipients still get all the reports.

After adding your omitted line "qd.SQL = strSQL" I now get error 3075 Syntax error missing operator in query expression ?

sorry it must be getting late over there now ??

 

[dhookom]

Again, "What is the actual SQL view of your query?"

The code I provided was simply a template of how to create a solution. The query name and the strSQL needed to be updated to match your application.

BTW: Welcome to Tek-Tips and it's only about 4:00 PM here ;-)

Duane
Hook'D on Access
MS Access MVP

 

[Stacey1306]

Glad its only 4pm,

ok my sql view is the following with query name being qryEmailInvoices

SELECT Members.MemberID, Payments.PaymentID, Payments.PaymentAmount, Payments.PaymentDate, Payments.PaymentMethodID, Year(Date()) AS [Year], MemberTypes.MemberType, MemberTypes.MemberDues, Members.[Organisation Name], Members.[Email Address], Members.MemberTypeID, Members.[Alternate Contact Name], Members.[Licensee FirstName], Members.[Licensee Lastname], Members.Address, Members.Suburb, Members.State, Members.PCode, Members.[Main Phone], Members.[Fax Number]
FROM (MemberTypes RIGHT JOIN Members ON MemberTypes.MemberTypeID=Members.MemberTypeID) LEFT JOIN Payments ON Members.MemberID=Payments.MemberID
WHERE (((Year([PaymentDate]))=Year(Date())))
ORDER BY Members.MemberID;

Hope this helps

 

[dhookom]

I would create a new query [qselEmailInvoiceSingleMember] and use it as the record source of your report. Then use the following code. This assumes MemberID is numeric.

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL as String
Dim qd As DAO.QueryDef

Set db = CurrentDb
Set rs = db.OpenRecordset("qryEmailInvoices", dbOpenDynaset)

[COLOR=#4E9A06]' qselEmailInvoiceSingleMember is the name of your new query that is the record source of your report[/color]
Set qd = db.QueryDefs("qselEmailInvoiceSingleMember")
rs.MoveFirst
Do
	vMemberID = rs("MemberID")
	[COLOR=#4E9A06]'strSQL is the SQL view of qselEmailInvoiceSingleMember[/color]
	strSQL = "SELECT * FROM qryEmailInvoices WHERE MemberID = " & vMemberID
	qd.SQL = strSQL
	DoCmd.SendObject acSendReport, "Email Invoices", "PDFFormat(*.pdf)", rs("Email Address"), _
              "", "", "Northern Beaches Liquor Accord Membership", _
              "Please find attached your invoice to renew your annual Membership", False
	rs.MoveNext
Loop Until rs.EOF
rs.Close
SET rs = Nothing
SET db = Nothing

Duane
Hook'D on Access
MS Access MVP

 

[Stacey1306]

Thanks Duane, this works !! your talents are so very much appreciated !!!

The emails are sent as expected - individual reports to each recipient however it is very slow - the second email takes a very long time - is there away to speed it up a little.

Also I am still getting the allow / deny any suggestions ?

 

[dhookom]

I'm not sure what is taking the most time. I expect the rendering of the PDF is the slowest part.

I don't have any experience with Redemption or other solutions for the allow/deny.

Duane
Hook'D on Access
MS Access MVP

 

[Stacey1306]

thank you anyway, you have helped me heaps !!

 

[Andrzejek]

> Also I am still getting the allow / deny any suggestions ?

Yes, I mentioned my suggestion some time ago. Did you try it?

Have fun.

---- Andy

 

[Stacey1306]

I am trying YesClick at the moment, and researching Redemption.

Thanks everyone

 

[Andrzejek]

If the Redemption approach will not work for you, check this post here about using CDO

Have fun.

---- Andy