I have a continuous form in Access 2007 that lists contacts for different agencies. Each record has a checkbox that I can use to generate a mass email to all selected contacts – it’s generic with no subject, no attachments and no message, for everyday use. However, the database owners would also like the ability to email a report to each contact (asking them to verify and update their information) using the checkboxes on this form.
Ideally, they would select the contacts they wanted to email, click the “Email Info Update Form” button and have Outlook send out an email to each of the contacts with their Contact Info Report attached. (I can address whether the emails go automatically or get reviewed later – I’m really just interested in getting the report attached to each email.)
Here's what I have-
This code (it's rough) opens multiple emails, although there seems to be a limit to the quantity. But I can' get the report to attach to more than one record-the one that has the focus at the time the button is clicked (that's why it's commented out):
This code attaches the report but only opens an email for the first contact:
Between the two, I feel like I'm close. But I've been working at this too long, and I'm beginning to think I'm missing something obvious.
Any input would be much appreciated. Thanks!
Ideally, they would select the contacts they wanted to email, click the “Email Info Update Form” button and have Outlook send out an email to each of the contacts with their Contact Info Report attached. (I can address whether the emails go automatically or get reviewed later – I’m really just interested in getting the report attached to each email.)
Here's what I have-
This code (it's rough) opens multiple emails, although there seems to be a limit to the quantity. But I can' get the report to attach to more than one record-the one that has the focus at the time the button is clicked (that's why it's commented out):
Code:
Private Sub Command18_Click()
Dim ol As Object
Dim msg As Object
Dim rec As DAO.Recordset
Dim intCount As Integer
Dim intLoop As Integer
Set ol = CreateObject("Outlook.Application")
Set rec = CurrentDb.OpenRecordset("qryLeadershipEmailListALL SelectQuery")
If Not (rec.BOF And rec.EOF) Then
rec.MoveLast
rec.MoveFirst
intCount = rec.RecordCount
For intLoop = 1 To intCount
Set msg = ol.CreateItem(olMailItem)
msg.Subject = "ENTER YOUR SUBJECT HERE"
msg.To = rec("Leadership Email")
msg.Body = "Message goes here."
msg.Body = msg.Body & Chr(13) & Chr(13) & "It's a really long message."
'DoCmd.OpenReport "AgencyUpdateForm", acViewPreview, , "[Agency Number]= forms![LeadershipEmailListALL].[Agency Number]"
'DoCmd.SendObject acSendReport, "AgencyUpdateForm", acFormatPDF, msg.To, , , msg.Subject, msg.Body
'msg.Attachments.Add "AgencyUpdateForm"
', acViewPreview, , "[Agency Number]= forms![LeadershipEmailListALL].[Agency Number]"
msg.Display
Set msg = Nothing
rec.MoveNext
Next intLoop
End If
Set rec = Nothing
Set ol = Nothing
End Sub
This code attaches the report but only opens an email for the first contact:
Code:
Private Sub Command43_Click()
On Error GoTo Err_Command43_Click
Me.Refresh
Dim strEMail As String
Dim strAddr As String
Dim dbs As DAO.Database
Dim rstEMail As DAO.Recordset
Dim stTo As String
Dim stCC As String
Dim stBcc As String
Dim stMessageSummary As String
Dim stSubjectSummary As String
'Retrieve all E-Mail Addressess
Set dbs = CurrentDb
Set rstEMail = dbs.OpenRecordset("qryLeadershipEmailListALL SelectQuery")
With rstEMail
Do While Not .EOF
'Build the Recipients String
strEMail = strEMail & ![Leadership Email] & ";"
.MoveNext
Loop
End With
stSubjectSummary = "Agency Contact Update Request for " & Me.Agency_Name
stMessageSummary = "Message goes here." & ""
stMessageSummary = stMessageSummary & Chr(13) & Chr(13) & "It's a really long message"
'Determine the stTo line
stTo = [Leadership Email]
stCC = ""
stBcc = ""
rstEMail.Close
Set rstEMail = Nothing
DoCmd.OpenReport "AgencyUpdateForm", acViewPreview, , "[Agency Number]= forms![LeadershipEmailListALL].[Agency Number]"
DoCmd.SendObject acSendReport, "AgencyUpdateForm", acFormatPDF, stTo, stCC, stBcc, stSubjectSummary, stMessageSummary
Exit_Command43_Click:
Exit Sub
Err_Command43_Click:
MsgBox "No contacts selected. Please try again."
Resume Exit_Command43_Click
End Sub
Any input would be much appreciated. Thanks!
Comment