Insert recordset list into e-mail message

P

PJFry

I am setting up an e-mail confirmation for folks who register for a retreat.
I have all but one part working just fine. What I would like to do is insert
a recordset into an e-mail message. I can do one record at a time with no
problem, but when it comes to a list, I am not sure where to go.

Here is what the message body would look like:

This confirms the registration for the Family Retreat for the following
members:

Mom name
Dad name
Kid 1
Kid 2
etc.

Closing Message here

With the names of the family members being the list. Here is the code so far:

Public Sub SendItem()
'Sends an e-mail with an attachement

Dim strFile As String
Dim strFamily As String

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set rsMail = New ADODB.Recordset
Set rsFamily = New ADODB.Recordset
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutLook = appOutlook.CreateItem(olMailItem)

strSQL = "SELECT * FROM tEmail WHERE lngRecordID = " & Forms!fFamily!RecordID

strMail = "SELECT * FROM tRetreatMailings WHERE lngRetreatID = " &
Forms!fFamily!lngRetreatID

strFamily = "SELECT tRetreat.RetreatID, tMember.RecordID,
tFamilyMembers.txtName " & _
"FROM (tRetreat INNER JOIN tMember ON tRetreat.RetreatID =
tMember.lngRetreatID) " & _
"LEFT JOIN tFamilyMembers ON tMember.RecordID = tFamilyMembers.lngRecordID "
& _
"WHERE (((tRetreat.RetreatID)= " & Forms!fFamily!lngRetreatID & ") " & _
"AND ((tMember.RecordID)= " & Forms!fFamily!RecordID & "));"

rs.Open strSQL, cn
rsMail.Open strMail, cn

strFile = rsMail!txtMailItem

With MailOutLook
.To = rs!txtEmail
.CC = ""
.BCC = ""
.Subject = rsMail!txtSubject
.Body = rsMail!txtMessage1& _
vbCrLf & _
* Insert the list of members here & _
vbCrLf & _
rsMail!txtClosing
.Attachments.Add strFile
.Send
End With

strSQL = "INSERT INTO tMailItemSent (lngRecordID,dtmSent,txtMailItem) " & _
"VALUES('" & rcdSelect & "','" & Now() & "','" & rsMail!txtDescription & "')"

DoCmd.RunSQL strSQL

rs.Close
Set rs = Nothing

rsMail.Close
Set rsMail = Nothing

End Sub

Thoughts on how to do this or suggestions for a better way?

Thanks!
PJ
 
G

Graham Mandeno

Hi PJ

It looks like you are already setting up a SQL string (strFamily) to return
you a recordset (rsFamily) of the family members, but you are not using it.
All you need to do is open that recordset and use a loop to extract the
member name from each record and append it to a string. Something like
this:

with rsFamily
.Open strFamily, cn
do until .EOF
strMembers = strMembers & " " & vbCrLf
.MoveNext
loop
.Close
End with

Then you have a list of members, one per line, that you can insert into your
email body text.
 
P

PJFry

Graham,

That was just the logic I was looking for.

Thanks!
PJ

Graham Mandeno said:
Hi PJ

It looks like you are already setting up a SQL string (strFamily) to return
you a recordset (rsFamily) of the family members, but you are not using it.
All you need to do is open that recordset and use a loop to extract the
member name from each record and append it to a string. Something like
this:

with rsFamily
.Open strFamily, cn
do until .EOF
strMembers = strMembers & " " & vbCrLf
.MoveNext
loop
.Close
End with

Then you have a list of members, one per line, that you can insert into your
email body text.
--
Good Luck :)

Graham Mandeno [Access MVP]
Auckland, New Zealand

PJFry said:
I am setting up an e-mail confirmation for folks who register for a
retreat.
I have all but one part working just fine. What I would like to do is
insert
a recordset into an e-mail message. I can do one record at a time with no
problem, but when it comes to a list, I am not sure where to go.

Here is what the message body would look like:

This confirms the registration for the Family Retreat for the following
members:

Mom name
Dad name
Kid 1
Kid 2
etc.

Closing Message here

With the names of the family members being the list. Here is the code so
far:

Public Sub SendItem()
'Sends an e-mail with an attachement

Dim strFile As String
Dim strFamily As String

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set rsMail = New ADODB.Recordset
Set rsFamily = New ADODB.Recordset
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutLook = appOutlook.CreateItem(olMailItem)

strSQL = "SELECT * FROM tEmail WHERE lngRecordID = " &
Forms!fFamily!RecordID

strMail = "SELECT * FROM tRetreatMailings WHERE lngRetreatID = " &
Forms!fFamily!lngRetreatID

strFamily = "SELECT tRetreat.RetreatID, tMember.RecordID,
tFamilyMembers.txtName " & _
"FROM (tRetreat INNER JOIN tMember ON tRetreat.RetreatID =
tMember.lngRetreatID) " & _
"LEFT JOIN tFamilyMembers ON tMember.RecordID = tFamilyMembers.lngRecordID
"
& _
"WHERE (((tRetreat.RetreatID)= " & Forms!fFamily!lngRetreatID & ") " & _
"AND ((tMember.RecordID)= " & Forms!fFamily!RecordID & "));"

rs.Open strSQL, cn
rsMail.Open strMail, cn

strFile = rsMail!txtMailItem

With MailOutLook
.To = rs!txtEmail
.CC = ""
.BCC = ""
.Subject = rsMail!txtSubject
.Body = rsMail!txtMessage1& _
vbCrLf & _
* Insert the list of members here & _
vbCrLf & _
rsMail!txtClosing
.Attachments.Add strFile
.Send
End With

strSQL = "INSERT INTO tMailItemSent (lngRecordID,dtmSent,txtMailItem) " &
_
"VALUES('" & rcdSelect & "','" & Now() & "','" & rsMail!txtDescription &
"')"

DoCmd.RunSQL strSQL

rs.Close
Set rs = Nothing

rsMail.Close
Set rsMail = Nothing

End Sub

Thoughts on how to do this or suggestions for a better way?

Thanks!
PJ
Click to expand...
Click to expand...
 
R

Rayhan

Hi Graham
I am just trying to insert email address from access 2000 table in the to box.
I used your code but it gives me error message, and it does not work
Would you have any suggestion?
Her are my codes I am using it from a Form
======
Public Function fncStartOutLook()
On Error GoTo StartError

Dim objOutlook As Object
Dim objItem As Object
Dim rs As Recordset


'Create a Microsoft Outlook object.
Set objOutlook = CreateObject("Outlook.Application")

'Create and open a new contact form for input.
Set objItem = objOutlook.CreateItem(olMailItem)


objItem.Display

With objItem
Do Until .EOF
.To = rs!Email & "; "
.MoveNext
Loop
.Close
End With

'Quit Microsoft Outlook.
Set objOutlook = Nothing

Exit Function
=========

Thank you
Rayhan

Graham Mandeno said:
Hi PJ

It looks like you are already setting up a SQL string (strFamily) to return
you a recordset (rsFamily) of the family members, but you are not using it.
All you need to do is open that recordset and use a loop to extract the
member name from each record and append it to a string. Something like
this:

with rsFamily
.Open strFamily, cn
do until .EOF
strMembers = strMembers & " " & vbCrLf
.MoveNext
loop
.Close
End with

Then you have a list of members, one per line, that you can insert into your
email body text.
--
Good Luck :)

Graham Mandeno [Access MVP]
Auckland, New Zealand

PJFry said:
I am setting up an e-mail confirmation for folks who register for a
retreat.
I have all but one part working just fine. What I would like to do is
insert
a recordset into an e-mail message. I can do one record at a time with no
problem, but when it comes to a list, I am not sure where to go.

Here is what the message body would look like:

This confirms the registration for the Family Retreat for the following
members:

Mom name
Dad name
Kid 1
Kid 2
etc.

Closing Message here

With the names of the family members being the list. Here is the code so
far:

Public Sub SendItem()
'Sends an e-mail with an attachement

Dim strFile As String
Dim strFamily As String

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set rsMail = New ADODB.Recordset
Set rsFamily = New ADODB.Recordset
Set appOutlook = CreateObject("Outlook.Application")
Set MailOutLook = appOutlook.CreateItem(olMailItem)

strSQL = "SELECT * FROM tEmail WHERE lngRecordID = " &
Forms!fFamily!RecordID

strMail = "SELECT * FROM tRetreatMailings WHERE lngRetreatID = " &
Forms!fFamily!lngRetreatID

strFamily = "SELECT tRetreat.RetreatID, tMember.RecordID,
tFamilyMembers.txtName " & _
"FROM (tRetreat INNER JOIN tMember ON tRetreat.RetreatID =
tMember.lngRetreatID) " & _
"LEFT JOIN tFamilyMembers ON tMember.RecordID = tFamilyMembers.lngRecordID
"
& _
"WHERE (((tRetreat.RetreatID)= " & Forms!fFamily!lngRetreatID & ") " & _
"AND ((tMember.RecordID)= " & Forms!fFamily!RecordID & "));"

rs.Open strSQL, cn
rsMail.Open strMail, cn

strFile = rsMail!txtMailItem

With MailOutLook
.To = rs!txtEmail
.CC = ""
.BCC = ""
.Subject = rsMail!txtSubject
.Body = rsMail!txtMessage1& _
vbCrLf & _
* Insert the list of members here & _
vbCrLf & _
rsMail!txtClosing
.Attachments.Add strFile
.Send
End With

strSQL = "INSERT INTO tMailItemSent (lngRecordID,dtmSent,txtMailItem) " &
_
"VALUES('" & rcdSelect & "','" & Now() & "','" & rsMail!txtDescription &
"')"

DoCmd.RunSQL strSQL

rs.Close
Set rs = Nothing

rsMail.Close
Set rsMail = Nothing

End Sub

Thoughts on how to do this or suggestions for a better way?

Thanks!
PJ
Click to expand...
Click to expand...
 
Top