joaolabisa
New member
- Local time
- Today, 03:37
- Joined
- Mar 19, 2014
- Messages
- 5
Hello to All,
I am trying to make an automation in order generate reports based on query ( person name,person email address ) , export them to a folder in PDF and then send them one by one to each person email address.
Please find my code below.
What is happening:
- the reports are generated and exported fine
- the email are sent to the right addresses but the first person receives the correct report , the second person receives the report from the first person plus its own report and so on...
I think some is wrong my structure , I am a VBA beginner ...
Help will be much appreciated !
Best Regards,
Here is my code :
I am trying to make an automation in order generate reports based on query ( person name,person email address ) , export them to a folder in PDF and then send them one by one to each person email address.
Please find my code below.
What is happening:
- the reports are generated and exported fine
- the email are sent to the right addresses but the first person receives the correct report , the second person receives the report from the first person plus its own report and so on...
I think some is wrong my structure , I am a VBA beginner ...
Help will be much appreciated !
Best Regards,
Here is my code :
Code:
Private Sub MakeReportSendEmail_Click()
Dim MyDB As DAO.Database
Dim MyRS As DAO.Recordset
Dim strSQL As String
Dim strRptName As String
Dim count As Integer
Dim strFilter As String
Dim imsg As Object
Dim iconf As Object
Dim flds As Object
Dim schema As String
Dim strPath As String
Dim strFilterEmail As String
Dim strFile As String
strRptName = "MyReportName"
strSQL = "SELECT * FROM MyQueryNameEmail ORDER BY Name"
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset(strSQL, dbOpenForwardOnly)
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") = "xxxx"
flds.Item(schema & "sendpassword") = "xxxx"
flds.Update
With MyRS
Do While Not MyRS.EOF
DoCmd.OpenReport strRptName, acViewPreview, , "[TableWithNames].Name='" & ![Name] & "'"
DoCmd.OutputTo acOutputReport, strDocName, acFormatPDF, "C:\Pdfs\" & ![Name] & ".pdf"
DoCmd.Close acReport, strRptName, acSaveNo
strPath = "C:\Pdfs\"
strFilterEmail = "*.pdf"
strFile = Dir(strPath & strFilterEmail)
With imsg
.to = MyRS.Fields("Email")
.From = "some_email"
.Subject = "Test Subject:"
.HTMLBody = "Test Body"
.AddAttachment strPath & strFile
Set .Configuration = iconf
.Send
End With
.MoveNext
Loop
End With
MyRS.Close
Set MyRS = Nothing
End Sub
