Paul Ager
05-03-2011, 07:32 AM
Hi,
Background – I want to send an email to multiple recipients based on the query results I receive.
I’ve managed to put together some code that sends an email which blind copies in the multiple recipients, enters a ‘From’ email address and places an attachment into the email. This works fine if I create a query ready and have the code point to it. What I’d like it to do is send the email based on the results I enter from a form. I’ve set up a form from a query which generates a subform based on the ‘Start date’ and ‘End Date’ field entries. Once the subform has generated the information and I’m happy with the recipients I’d like to use the results to send the email. How can I use these results to do this?
I have placed the email code and the code for the subform using the query below. The query on the email code is different from query on the Form because the Form query has criteria prompting the date entry ‘Between [Forms]![frmexpiry_by_date]![StartDate] And [Forms]![frmexpiry_by_date]![EndDate].
Option Compare Database
Public Function SendEMail()
Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim wd As Word.Application
Dim doc As Word.Document
' Access Email Template Word Doc.
Set wd = GetObject(, "Word.Application")
Set doc = wd.Documents.Open _
(FileName:="C:\My Documents\Email Template.doc", ReadOnly:=True)
' Set the subject.
Subjectline = "Reminder"
' Open Outlook for our own device.
Set MyOutlook = New Outlook.Application
' Set up the database and query connections
Set db = CurrentDb()
Set MailList = db.OpenRecordset("qryexp_may11")
' Loop through the list of addresses.
' Add them to e-mail and send them.
' Create the e-mail
' Open the email template word doc.
Set MyMail = doc.MailEnvelope.Item
' Start Loop
Do Until MailList.EOF
' Add Addresses from the query.
strMailList = strMailList & MailList.Fields("Email") & ";"
MyMail.BCC = strMailList
MailList.MoveNext
Loop
' Change the from field
MyMail.SentOnBehalfOfName = "anyemailaddress@email.co.UK"
' Give it a subject
MyMail.Subject = Subjectline$
' Add attachment
MyMail.Attachments.Add "C:\My Documents\Email Attachment.doc"
' Send it.
MyMail.Send
' Cleanup.
doc.Close wdDoNotSaveChanges
wd.Quit
Set MyMail = Nothing
Set wd = Nothing
Set MyOutlook = Nothing
MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing
End Function
Private Sub OK_Click()
[SubForm_qryexp_date].Requery
[SubForm_qryexp_date].Visible = True
DoCmd.OpenForm ("frmexpiry_by_date")
End Sub
Any help would be greatly appreciated. This is the last problem that needs fixing before this is completed.
Paul
Background – I want to send an email to multiple recipients based on the query results I receive.
I’ve managed to put together some code that sends an email which blind copies in the multiple recipients, enters a ‘From’ email address and places an attachment into the email. This works fine if I create a query ready and have the code point to it. What I’d like it to do is send the email based on the results I enter from a form. I’ve set up a form from a query which generates a subform based on the ‘Start date’ and ‘End Date’ field entries. Once the subform has generated the information and I’m happy with the recipients I’d like to use the results to send the email. How can I use these results to do this?
I have placed the email code and the code for the subform using the query below. The query on the email code is different from query on the Form because the Form query has criteria prompting the date entry ‘Between [Forms]![frmexpiry_by_date]![StartDate] And [Forms]![frmexpiry_by_date]![EndDate].
Option Compare Database
Public Function SendEMail()
Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim wd As Word.Application
Dim doc As Word.Document
' Access Email Template Word Doc.
Set wd = GetObject(, "Word.Application")
Set doc = wd.Documents.Open _
(FileName:="C:\My Documents\Email Template.doc", ReadOnly:=True)
' Set the subject.
Subjectline = "Reminder"
' Open Outlook for our own device.
Set MyOutlook = New Outlook.Application
' Set up the database and query connections
Set db = CurrentDb()
Set MailList = db.OpenRecordset("qryexp_may11")
' Loop through the list of addresses.
' Add them to e-mail and send them.
' Create the e-mail
' Open the email template word doc.
Set MyMail = doc.MailEnvelope.Item
' Start Loop
Do Until MailList.EOF
' Add Addresses from the query.
strMailList = strMailList & MailList.Fields("Email") & ";"
MyMail.BCC = strMailList
MailList.MoveNext
Loop
' Change the from field
MyMail.SentOnBehalfOfName = "anyemailaddress@email.co.UK"
' Give it a subject
MyMail.Subject = Subjectline$
' Add attachment
MyMail.Attachments.Add "C:\My Documents\Email Attachment.doc"
' Send it.
MyMail.Send
' Cleanup.
doc.Close wdDoNotSaveChanges
wd.Quit
Set MyMail = Nothing
Set wd = Nothing
Set MyOutlook = Nothing
MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing
End Function
Private Sub OK_Click()
[SubForm_qryexp_date].Requery
[SubForm_qryexp_date].Visible = True
DoCmd.OpenForm ("frmexpiry_by_date")
End Sub
Any help would be greatly appreciated. This is the last problem that needs fixing before this is completed.
Paul