Use Query Results to send Email

[Paul Ager]

Hi,



Background – I want to send an email to multiple recipients based on the query results I generate on a form.

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 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

[Cheshire101]

I am not sure if you want to go down this road, but I did something similar.
What I did was create a table that records the email being sent and has a field with autonumber.
Table Fields:
ID(autonumber), Employee (text), Reason (text), SentDate (Date/Time)
**The reason field is because there are several reasons why an email can be sent from my database.

Then I have an Append query that uploads the information to the table.

Using DMax and Dmin I find the numbers issued to who needs to receive the email.
Example: varX = DMax("ID","tblTableName","Reason = 'Overdue' AND SentDate = Date()")

Then loop using the numbers you now have....If you do not need to record the email being sent you could also run a delete query before the append query.

Hope this helps.

[islo]

Has this issue been resolved yet? If YES please share . I am in need of a similar solution. Thanks