Send access report to more than 1 person by email

[puppygirl3939]

I have been able to get this to work only if I enter the e-mail address directly into the code. How can I have the code lookup it from a query and send to more than one person.

The query must be filtered by the referral ID# on the form then is should loop and take all of the contacts on that query and format it.
Example JohnDoe@test.com;Bdoe@testing.com etc. I would call the result of the query refsend.

I believe I should then be able to add the variable to the code like this:
DoCmd.SendObject acSendReport, stDocName, acFormatSNP, refsend, "", "", "test", "Testing", , True

 

[jdegeorge]

You'd have to have your query append each required email address to a string named "refsend", separated by the ";" between each address.

Jim DeGeorge

 

[LeafyJellyFish]

I have a form that does something similar to what you want. I have a form that has a command button. In the on-click event it will bring up another form that allows you to select multiple recipients, then send. It doesn't include attachments. I have pasted the code. If you need anything else, let me know. Hope this helps.


Dim rs As Recordset, strSQL As String, strUpdate As String
Dim lngKeyID As Long, lngRecipID As Long, strRecipName As String
Dim strTo As String, strCC As String, strSubject As String, strMessage As String

Private Sub cmdMail_Click()
On Error GoTo CancelMail

' Check for recipients

strSQL = "SELECT * FROM qryEmailMemo WHERE EmailMemo_MemoIDKey = " & LngMemoKey
Set rs = CurrentDb.OpenRecordset(strSQL)
If rs.EOF Then MsgBox "There are no recipients selected": Exit Sub

' Set Mail "To"

strSQL = "SELECT * FROM qryEmailMemo WHERE EmailMemo_RecipType = 1 AND EmailMemo_MemoIDKey = " & LngMemoKey
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
If rs.EOF Then strTo = "": GoTo MailCC

rs.MoveFirst
'strTo = &quot;<&quot; & rs!RecipName & &quot;>&quot; & rs!RecipEmail
strTo = rs!RecipEmail
rs.MoveNext

Do While Not rs.EOF
'strTo = strTo & &quot;;&quot; & &quot;<&quot; & rs!RecipName & &quot;>&quot; & rs!RecipEmail
strTo = strTo & &quot;;&quot; & rs!RecipEmail
rs.MoveNext
Loop

'Set Mail &quot;CC&quot;

MailCC:

strSQL = &quot;SELECT * FROM qryEmailMemo WHERE EmailMemo_RecipType = 2 AND EmailMemo_MemoIDKey = &quot; & LngMemoKey
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
If rs.EOF Then strCC = &quot;&quot;: GoTo CreateMessage

rs.MoveFirst
'strCC = &quot;<&quot; & rs!RecipName & &quot;>&quot; & rs!RecipEmail
strCC = rs!RecipEmail
rs.MoveNext

Do While Not rs.EOF
'strCC = strCC & &quot;;&quot; & &quot;<&quot; & rs!RecipName & &quot;>&quot; & rs!RecipEmail
strCC = strCC & &quot;;&quot; & rs!RecipEmail
rs.MoveNext
Loop

' Set Subject & Text, Create Message

CreateMessage:

strSubject = &quot;RE: &quot; & Me.txtCustomer

If IsNull(Me.txtMemo) Or Me.txtMemo = &quot;&quot; Then
strMessage = &quot;&quot;
Else
strMessage = Me.txtMemo
End If

DoCmd.SendObject , , , strTo, strCC, , strSubject, strMessage

' Update tblEmailMemo after sending message

strUpdate = _
&quot;UPDATE tblEmailMemo &quot; & vbCrLf & _
&quot;SET EmailMemo_RecipSent = -1, EmailMemo_RecipListed = 0, EmailMemo_EmailTime = Now()&quot; & vbCrLf & _
&quot;WHERE EmailMemo_MemoIDKey = &quot; & LngMemoKey & vbCrLf & _
&quot;AND EmailMemo_RecipListed = -1&quot;

CurrentDb.Execute (strUpdate)

DoCmd.Close

Exit Sub

' If message cancels before sending

CancelMail:

MsgBox &quot;Mail message was cancelled&quot;

End Sub

Private Sub cboSelectRecipientTo_AfterUpdate()

strRecipName = Me.cboSelectRecipientTo.Column(1)
strSQL = &quot;Do you want to add &quot; & strRecipName & &quot; as a (To) Recipient ?&quot;
If MsgBox(strSQL, vbYesNo + vbDefaultButton1) = vbNo Then Exit Sub

lngRecipID = Me.cboSelectRecipientTo
strSQL = &quot;tblEmailMemo&quot;
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
rs.AddNew
rs!EmailMemo_MemoIDKey = LngMemoKey
rs!EmailMemo_RecipIDKey = lngRecipID
rs!EmailMemo_RecipType = 1
rs!EmailMemo_RecipListed = -1
rs.Update
rs.Close
strQueryCriteria = LngMemoKey
Me.lstRecipientsTo.Requery
Me.cboSelectRecipientTo = &quot;&quot;
Me.cboSelectRecipientTo.SetFocus

End Sub

Private Sub cmdDeleteRecipientTo_Click()

Me.lstRecipientsTo.SetFocus

If IsNull(Me.lstRecipientsTo.Column(0)) Then
strSQL = &quot;You must first select a recipient to Delete&quot;
MsgBox strSQL
Exit Sub
End If

lngKeyID = Me.lstRecipientsTo.Column(0)
strRecipName = Me.lstRecipientsTo.Column(2)
strSQL = &quot;Are you sure you want to remove &quot; & strRecipName & &quot; from the e-mail ?&quot;
If MsgBox(strSQL, vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub

Set rs = CurrentDb.OpenRecordset(&quot;tblEmailMemo&quot;, dbOpenDynaset)
rs.FindFirst &quot;[EmailMemo_ID] = &quot; & lngKeyID
rs.Delete
strQueryCriteria = LngMemoKey
Me.lstRecipientsTo.Requery
Me.cboSelectRecipientTo.SetFocus

End Sub

Private Sub cboSelectRecipientCC_AfterUpdate()

strRecipName = Me.cboSelectRecipientCC.Column(1)
strSQL = &quot;Do you want to add &quot; & strRecipName & &quot; as a (CC) Recipient ?&quot;
If MsgBox(strSQL, vbYesNo + vbDefaultButton1) = vbNo Then Exit Sub

lngRecipID = Me.cboSelectRecipientCC
strSQL = &quot;tblEmailMemo&quot;
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
rs.AddNew
rs!EmailMemo_MemoIDKey = LngMemoKey
rs!EmailMemo_RecipIDKey = lngRecipID
rs!EmailMemo_RecipType = 2
rs!EmailMemo_RecipListed = -1
rs.Update
rs.Close
strQueryCriteria = LngMemoKey
Me.lstRecipientsCC.Requery
Me.cboSelectRecipientCC = &quot;&quot;
Me.cboSelectRecipientCC.SetFocus

End Sub

Private Sub cmdDeleteRecipientCC_Click()

Me.lstRecipientsCC.SetFocus

If IsNull(Me.lstRecipientsCC.Column(0)) Then
strSQL = &quot;You must first select a recipient to Delete&quot;
MsgBox strSQL
Exit Sub
End If

lngKeyID = Me.lstRecipientsCC.Column(0)
strRecipName = Me.lstRecipientsCC.Column(2)
strSQL = &quot;Are you sure you want to remove &quot; & strRecipName & &quot; from the e-mail ?&quot;
If MsgBox(strSQL, vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub

Set rs = CurrentDb.OpenRecordset(&quot;tblEmailMemo&quot;, dbOpenDynaset)
rs.FindFirst &quot;[EmailMemo_ID] = &quot; & lngKeyID
rs.Delete
strQueryCriteria = LngMemoKey
Me.lstRecipientsCC.Requery
Me.cboSelectRecipientCC.SetFocus

End Sub

Private Sub Form_Current()

strQueryCriteria = LngMemoKey
Me.lstRecipientsTo.Requery
Me.cboSelectRecipientTo = &quot;&quot;
Me.lstRecipientsCC.Requery
Me.cboSelectRecipientCC = &quot;&quot;
Me.cboSelectRecipientTo.SetFocus

End Sub

Private Sub cmdExit_Click()

DoCmd.Close

End Sub



Thanks
LeafyJellyFish