Generate and send by email individual reports based on a query
- Thread starter joaolabisa
- Start date
Ok cool! Thanks soooooo much that worked!! As RevisionNo is text I wrote the code this way:
DoCmd.OpenReport strRptName, acViewPreview, , "[OrderID]=" & ![OrderID] & "And" & "[RevisionNo]='" & ![RevisionNo] & "'"
DoCmd.OpenReport strRptName, acViewPreview, , "[OrderID]=" & ![OrderID] & "And" & "[RevisionNo]='" & ![RevisionNo] & "'"
OK, I've just tried to test this on a network with Exchange and I'm getting the same error:
The SendUsing configuration is invalid.
This is the configuration:
Set iMsg = CreateObject("CDO.Message")
Set iconf = CreateObject("CDO.Configuration")
Set flds = iconf.Fields
schema = "...schemas.microsoft.com/cdo/configuration/"
flds.Item(schema & "sendusing") = 2
flds.Item(schema & "smtpserver") = "smtp"
flds.Item(schema & "smtpserverport") = 25
flds.Item(schema & "smtpauthenticate") = 1
flds.Item(schema & "smtpusessl") = True
flds.Item(schema & "smtpconnectiontimeout") = 60
flds.Item(schema & "sendusername") = ""
flds.Item(schema & "sendpassword") = ""
flds.Update
You said in an earlier post that you use your server's address. How would I change the above code to incorporate the server address?
The SendUsing configuration is invalid.
This is the configuration:
Set iMsg = CreateObject("CDO.Message")
Set iconf = CreateObject("CDO.Configuration")
Set flds = iconf.Fields
schema = "...schemas.microsoft.com/cdo/configuration/"
flds.Item(schema & "sendusing") = 2
flds.Item(schema & "smtpserver") = "smtp"
flds.Item(schema & "smtpserverport") = 25
flds.Item(schema & "smtpauthenticate") = 1
flds.Item(schema & "smtpusessl") = True
flds.Item(schema & "smtpconnectiontimeout") = 60
flds.Item(schema & "sendusername") = ""
flds.Item(schema & "sendpassword") = ""
flds.Update
You said in an earlier post that you use your server's address. How would I change the above code to incorporate the server address?
OK.....I've now ditched the CDO method (because it just doesn't seem to work for me!) & now I'm trying something different (using Outlook). I've got the following code:
Dim strSql
Dim db As Database
Set db = CurrentDb()
Dim rs As Recordset
Dim Lrs As DAO.Recordset
Dim Outlook
Dim rng
Dim OutApp As Object
Dim OutMail As Object
strRptName = "CompleteLintelsInvoiceBATCHTESTCOPY"
strSql = "SELECT * FROM zzqryTrialInvoiceBATCHTESTCOPY ORDER BY zzqryTrialInvoiceBATCHTESTCOPY.OrderID"
Set Lrs = db.OpenRecordset(strSql, dbOpenForwardOnly)
With Lrs
Do While Not Lrs.EOF
DoCmd.OpenReport strRptName, acViewPreview, , "[OrderID]=" & ![OrderID]
'Debug.Print ("OrderID: " & Lrs!OrderID & " Qty " & Lrs!Qty)
DoCmd.OutputTo acOutputReport, strRptName, acFormatPDF, "C:\TempInvoicePDF\" & ![OrderID] & ".pdf"
DoCmd.Close acReport, strRptName, acSaveNo
strpath = "C:\TempInvoicePDF\"
strFilterEmail = "*.pdf"
strFile = Dir(strpath & strFilterEmail)
Outlook = Outlook + Lrs("EmailAddress")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Outlook
'.CC = ""
'.BCC = ""
.Subject = "Test"
.HTMLBody = "Test Invoice"
.Attachments.Add (strpath & strFile)
'.Display
.Send
End With
Lrs.MoveNext
'Debug.Print ("OrderID: " & Lrs!OrderID & " Qty " & Lrs!Qty)
Debug.Print (strpath & strFile)
Loop
End With
Lrs.Close
On Error GoTo 0
Set Lrs = Nothing
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Emails sent OK"
I'm trying to get the code to loop through the recordset and produce an invoice in PDF format and attach this to an email for each OrderID record. The PDF's produce correctly to the TempInvoicePDF folder however only the first email and with the first attachment is successfully is produced and sent. Outlook then proceeds to give me the Microsoft Office Outlook security warning (that a program is trying to send an email...) a further 2 times however there is no email produced. I'm a bit stuck with my looping....can anyone see if there is a glaring error in the loop? Many thanks!!
Dim strSql
Dim db As Database
Set db = CurrentDb()
Dim rs As Recordset
Dim Lrs As DAO.Recordset
Dim Outlook
Dim rng
Dim OutApp As Object
Dim OutMail As Object
strRptName = "CompleteLintelsInvoiceBATCHTESTCOPY"
strSql = "SELECT * FROM zzqryTrialInvoiceBATCHTESTCOPY ORDER BY zzqryTrialInvoiceBATCHTESTCOPY.OrderID"
Set Lrs = db.OpenRecordset(strSql, dbOpenForwardOnly)
With Lrs
Do While Not Lrs.EOF
DoCmd.OpenReport strRptName, acViewPreview, , "[OrderID]=" & ![OrderID]
'Debug.Print ("OrderID: " & Lrs!OrderID & " Qty " & Lrs!Qty)
DoCmd.OutputTo acOutputReport, strRptName, acFormatPDF, "C:\TempInvoicePDF\" & ![OrderID] & ".pdf"
DoCmd.Close acReport, strRptName, acSaveNo
strpath = "C:\TempInvoicePDF\"
strFilterEmail = "*.pdf"
strFile = Dir(strpath & strFilterEmail)
Outlook = Outlook + Lrs("EmailAddress")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Outlook
'.CC = ""
'.BCC = ""
.Subject = "Test"
.HTMLBody = "Test Invoice"
.Attachments.Add (strpath & strFile)
'.Display
.Send
End With
Lrs.MoveNext
'Debug.Print ("OrderID: " & Lrs!OrderID & " Qty " & Lrs!Qty)
Debug.Print (strpath & strFile)
Loop
End With
Lrs.Close
On Error GoTo 0
Set Lrs = Nothing
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Emails sent OK"
I'm trying to get the code to loop through the recordset and produce an invoice in PDF format and attach this to an email for each OrderID record. The PDF's produce correctly to the TempInvoicePDF folder however only the first email and with the first attachment is successfully is produced and sent. Outlook then proceeds to give me the Microsoft Office Outlook security warning (that a program is trying to send an email...) a further 2 times however there is no email produced. I'm a bit stuck with my looping....can anyone see if there is a glaring error in the loop? Many thanks!!
I've altered my code now slightly. The recordset has 3 records....the code loops through and produces 3 emails to 3 separate email addresses HOWEVER it attaches the same PDF to all 3 emails. I cannot figure out why! Can anyone help?
Dim strSql
Dim db As Database
Set db = CurrentDb()
Dim rs As Recordset
Dim Lrs As DAO.Recordset
Dim Outlook
Dim rng
Dim OutApp As Object
Dim OutMail As Object
strRptName = "CompleteLintelsInvoiceBATCHTESTCOPY"
strSql = "SELECT * FROM zzqryTrialInvoiceBATCHTESTCOPY ORDER BY zzqryTrialInvoiceBATCHTESTCOPY.OrderID"
Set Lrs = db.OpenRecordset(strSql, dbOpenSnapshot)
With Lrs
Do While Not Lrs.EOF
DoCmd.OpenReport strRptName, acViewPreview, , "[OrderID]=" & ![OrderID]
Debug.Print ("OrderID: " & Lrs!OrderID & " Qty " & Lrs!Qty)
DoCmd.OutputTo acOutputReport, strRptName, acFormatPDF, "C:\TempInvoicePDF\" & ![OrderID] & ".pdf"
DoCmd.Close acReport, strRptName, acSaveNo
strpath = "C:\TempInvoicePDF\"
strFilterEmail = "*.pdf"
strFile = Dir(strpath & strFilterEmail)
Outlook = Outlook + Lrs("EmailAddress")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Lrs!EMailAddress
'.CC = ""
'.BCC = ""
.Subject = "Test Invoice" & " " & Lrs!OrderID
.HTMLBody = "Test Invoice" & " " & Lrs!OrderID
.Attachments.Add strpath & strFile
.Display
'.Send
End With
Lrs.MoveNext
Loop
End With
Lrs.Close
On Error GoTo 0
Set Lrs = Nothing
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Emails sent OK"
Dim strSql
Dim db As Database
Set db = CurrentDb()
Dim rs As Recordset
Dim Lrs As DAO.Recordset
Dim Outlook
Dim rng
Dim OutApp As Object
Dim OutMail As Object
strRptName = "CompleteLintelsInvoiceBATCHTESTCOPY"
strSql = "SELECT * FROM zzqryTrialInvoiceBATCHTESTCOPY ORDER BY zzqryTrialInvoiceBATCHTESTCOPY.OrderID"
Set Lrs = db.OpenRecordset(strSql, dbOpenSnapshot)
With Lrs
Do While Not Lrs.EOF
DoCmd.OpenReport strRptName, acViewPreview, , "[OrderID]=" & ![OrderID]
Debug.Print ("OrderID: " & Lrs!OrderID & " Qty " & Lrs!Qty)
DoCmd.OutputTo acOutputReport, strRptName, acFormatPDF, "C:\TempInvoicePDF\" & ![OrderID] & ".pdf"
DoCmd.Close acReport, strRptName, acSaveNo
strpath = "C:\TempInvoicePDF\"
strFilterEmail = "*.pdf"
strFile = Dir(strpath & strFilterEmail)
Outlook = Outlook + Lrs("EmailAddress")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Lrs!EMailAddress
'.CC = ""
'.BCC = ""
.Subject = "Test Invoice" & " " & Lrs!OrderID
.HTMLBody = "Test Invoice" & " " & Lrs!OrderID
.Attachments.Add strpath & strFile
.Display
'.Send
End With
Lrs.MoveNext
Loop
End With
Lrs.Close
On Error GoTo 0
Set Lrs = Nothing
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Emails sent OK"
- Local time
- Today, 03:20
- Joined
- Aug 30, 2003
- Messages
- 36,270
Regarding post 48, Exchange yes Outlook no, but CDO bypasses Outlook anyway. Regarding your last, you don't appear to send the same path that you save. Have you tried using the same string when adding the attachment as when saving the file?
Oh ok, thanks for letting me know..... I just don't understand why I can't get it working for me, I'm using Exchange 2010.
My attachment path is coded as .Attachments.Add strpath & strFile
so isn't this essentially the same path as the saved path?
My attachment path is coded as .Attachments.Add strpath & strFile
so isn't this essentially the same path as the saved path?
pbaldy, you provided me with some inspirational thinking and I can't thank you enough!!! 
I changed the strFilterEmail line from "*.pdf" to Lrs!OrderID & ".pdf" and the correct attachments now attach to each email. My full working for anyone else out there is:
Dim strSql
Dim db As Database
Set db = CurrentDb()
Dim rs As Recordset
Dim Lrs As DAO.Recordset
Dim Outlook
Dim rng
Dim OutApp As Object
Dim OutMail As Object
strRptName = "CompleteLintelsInvoiceBATCHTESTCOPY"
strSql = "SELECT * FROM zzqryTrialInvoiceBATCHTESTCOPY ORDER BY zzqryTrialInvoiceBATCHTESTCOPY.OrderID"
Set Lrs = db.OpenRecordset(strSql, dbOpenSnapshot)
With Lrs
Do While Not Lrs.EOF
'Must open the invoice in Preview mode
DoCmd.OpenReport strRptName, acViewPreview, , "[OrderID]=" & ![OrderID]
'Debug.Print ("OrderID: " & MyRS!OrderID & " Qty " & MyRS!Qty)
DoCmd.OutputTo acOutputReport, strRptName, acFormatPDF, "C:\TempInvoicePDF\" & ![OrderID] & ".pdf"
DoCmd.Close acReport, strRptName, acSaveNo
strpath = "C:\TempInvoicePDF\"
strFilterEmail = Lrs!OrderID & ".pdf"
strFile = Dir(strpath & strFilterEmail)
Outlook = Outlook + Lrs("EmailAddress")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Lrs!EMailAddress
'.CC = ""
'.BCC = ""
.Subject = "Test Invoice" & " " & Lrs!OrderID
.HTMLBody = "Test Invoice" & " " & Lrs!OrderID
.Attachments.Add strpath & strFile
'.Display
.Send
End With
Lrs.MoveNext
Loop
End With
Lrs.Close
On Error GoTo 0
Set Lrs = Nothing
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Emails sent OK"
End Sub
Using this method generates tbe Outlook Security warning but you can treat that with using the third party software (ClickYes Pro 2010).
But I wish I could have got this working with CDO!!!!!
I changed the strFilterEmail line from "*.pdf" to Lrs!OrderID & ".pdf" and the correct attachments now attach to each email. My full working for anyone else out there is:
Dim strSql
Dim db As Database
Set db = CurrentDb()
Dim rs As Recordset
Dim Lrs As DAO.Recordset
Dim Outlook
Dim rng
Dim OutApp As Object
Dim OutMail As Object
strRptName = "CompleteLintelsInvoiceBATCHTESTCOPY"
strSql = "SELECT * FROM zzqryTrialInvoiceBATCHTESTCOPY ORDER BY zzqryTrialInvoiceBATCHTESTCOPY.OrderID"
Set Lrs = db.OpenRecordset(strSql, dbOpenSnapshot)
With Lrs
Do While Not Lrs.EOF
'Must open the invoice in Preview mode
DoCmd.OpenReport strRptName, acViewPreview, , "[OrderID]=" & ![OrderID]
'Debug.Print ("OrderID: " & MyRS!OrderID & " Qty " & MyRS!Qty)
DoCmd.OutputTo acOutputReport, strRptName, acFormatPDF, "C:\TempInvoicePDF\" & ![OrderID] & ".pdf"
DoCmd.Close acReport, strRptName, acSaveNo
strpath = "C:\TempInvoicePDF\"
strFilterEmail = Lrs!OrderID & ".pdf"
strFile = Dir(strpath & strFilterEmail)
Outlook = Outlook + Lrs("EmailAddress")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Lrs!EMailAddress
'.CC = ""
'.BCC = ""
.Subject = "Test Invoice" & " " & Lrs!OrderID
.HTMLBody = "Test Invoice" & " " & Lrs!OrderID
.Attachments.Add strpath & strFile
'.Display
.Send
End With
Lrs.MoveNext
Loop
End With
Lrs.Close
On Error GoTo 0
Set Lrs = Nothing
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Emails sent OK"
End Sub
Using this method generates tbe Outlook Security warning but you can treat that with using the third party software (ClickYes Pro 2010).
But I wish I could have got this working with CDO!!!!!
Good morning all,
Office 2013 is driving me bananas!!! The following code worked perfectly in Access 2013 and Outlook 2003. I had to upgrade all of the workstations to Office 2013 yesterday & now I cannot get my code to work. The code halts at the red highlighted section below and I receive the "Too Few Parameters" error. Does anyone know why installing Office 2013 would now cause this?
Private Sub MakeReportSendEmail_Click()
Dim strSql
Dim strSQL2
Dim db As Database
Set db = CurrentDb()
Dim rs As Recordset
Dim Lrs As DAO.Recordset
Dim Lrs2 As DAO.Recordset
Dim Outlook
Dim rng
Dim OutApp As Object
Dim OutMail As Object
strRptName = "InvoiceBATCHTESTCOPY"
strSql = "SELECT * FROM zzqryTrialInvoiceBATCHTESTCOPY ORDER BY zzqryTrialInvoiceBATCHTESTCOPY.OrderID"
strSQL2 = "SELECT * FROM zzqryTrialInvoiceBATCHTESTCOPYFILTER ORDER BY zzqryTrialInvoiceBATCHTESTCOPYFILTER.OrderID"
Set Lrs = db.OpenRecordset(strSql, dbOpenForwardOnly)
Set Lrs2 = db.OpenRecordset(strSQL2, dbOpenSnapshot)
With Lrs2
Do While Not Lrs2.EOF
'Must open the invoice in Preview mode
DoCmd.OpenReport strRptName, acViewPreview, , "[OrderID]=" & ![OrderID]
'Debug.Print ("OrderID: " & MyRS!OrderID & " Qty " & MyRS!Qty)
DoCmd.OutputTo acOutputReport, strRptName, acFormatPDF, "C:\TempInvoicePDF\" & ![OrderID] & ".pdf"
DoCmd.Close acReport, strRptName, acSaveNo
strpath = "C:\TempInvoicePDF\"
strFilterEmail = Lrs2!OrderID & ".pdf"
strFile = Dir(strpath & strFilterEmail)
Outlook = Outlook + Lrs2("EmailAddress")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Lrs2!EMailAddress
'.CC = ""
'.BCC = ""
.Subject = "Tax Invoice" & " " & Lrs2!OrderID
.HTMLBody = "Tax Invoice" & " " & Lrs2!OrderID
.Attachments.Add strpath & strFile
'.Display
.Send
End With
Lrs2.MoveNext
Loop
End With
Lrs2.Close
On Error GoTo 0
Set Lrs = Nothing
Set Lrs2 = Nothing
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Emails sent OK"
End Sub
Office 2013 is driving me bananas!!! The following code worked perfectly in Access 2013 and Outlook 2003. I had to upgrade all of the workstations to Office 2013 yesterday & now I cannot get my code to work. The code halts at the red highlighted section below and I receive the "Too Few Parameters" error. Does anyone know why installing Office 2013 would now cause this?
Private Sub MakeReportSendEmail_Click()
Dim strSql
Dim strSQL2
Dim db As Database
Set db = CurrentDb()
Dim rs As Recordset
Dim Lrs As DAO.Recordset
Dim Lrs2 As DAO.Recordset
Dim Outlook
Dim rng
Dim OutApp As Object
Dim OutMail As Object
strRptName = "InvoiceBATCHTESTCOPY"
strSql = "SELECT * FROM zzqryTrialInvoiceBATCHTESTCOPY ORDER BY zzqryTrialInvoiceBATCHTESTCOPY.OrderID"
strSQL2 = "SELECT * FROM zzqryTrialInvoiceBATCHTESTCOPYFILTER ORDER BY zzqryTrialInvoiceBATCHTESTCOPYFILTER.OrderID"
Set Lrs = db.OpenRecordset(strSql, dbOpenForwardOnly)
Set Lrs2 = db.OpenRecordset(strSQL2, dbOpenSnapshot)
With Lrs2
Do While Not Lrs2.EOF
'Must open the invoice in Preview mode
DoCmd.OpenReport strRptName, acViewPreview, , "[OrderID]=" & ![OrderID]
'Debug.Print ("OrderID: " & MyRS!OrderID & " Qty " & MyRS!Qty)
DoCmd.OutputTo acOutputReport, strRptName, acFormatPDF, "C:\TempInvoicePDF\" & ![OrderID] & ".pdf"
DoCmd.Close acReport, strRptName, acSaveNo
strpath = "C:\TempInvoicePDF\"
strFilterEmail = Lrs2!OrderID & ".pdf"
strFile = Dir(strpath & strFilterEmail)
Outlook = Outlook + Lrs2("EmailAddress")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Lrs2!EMailAddress
'.CC = ""
'.BCC = ""
.Subject = "Tax Invoice" & " " & Lrs2!OrderID
.HTMLBody = "Tax Invoice" & " " & Lrs2!OrderID
.Attachments.Add strpath & strFile
'.Display
.Send
End With
Lrs2.MoveNext
Loop
End With
Lrs2.Close
On Error GoTo 0
Set Lrs = Nothing
Set Lrs2 = Nothing
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Emails sent OK"
End Sub
Yes, that is right. But no it didn't happen in the previous versions, that's why this has got me stumped. I tested the same code on an Access 2013 Frontend with Outlook 2003 and I don't get this error. I will deconstruct the query and rewrite it, maybe something got corrupted in the SQL. I'll let you know my outcome.
- Local time
- Today, 03:20
- Joined
- Aug 30, 2003
- Messages
- 36,270
I think that has always happened when opening a recordset on a query with parameters:
http://support.microsoft.com/default.aspx?scid=kb;en-us;209203
I certainly ran into it a long time ago.
http://support.microsoft.com/default.aspx?scid=kb;en-us;209203
I certainly ran into it a long time ago.
