Export form records to one email message..

[Arcadia]

Hi everyone i have a question and really hope someone can help me out:

In acces i have made a form with several records, the information in those records are send out to the body of a email message in Outlook i did that by a VBA code so if a users presses on that button it will do the job, but the problem is that it only picks the data of the current record and not all records of the form.


Is there a way to edit my VBA code so i will be able to this?


Private Sub Send_Mail_Click()

Set fso = CreateObject("Scripting.FileSystemObject")
Set olObj = GetObject(, "Outlook.Application")
Set olmail = olObj.createitem(olMailItem)




olmail.Subject = "Training"
olmail.Importance = "2"
olmail.To = ""
olmail.cc = ""
olmail.bcc = ""
olmail.htmlbody = "<p> Hello, here are the dates</p> " & vbNewLine & vbNewLine & "Title:" & " " & [Title] & vbNewLine & "Location:" & " " & [Location] & vbNewLine & "Start Time:" & " " & [Start Time] & vbNewLine & "End Time:" & " " & [End Time] & vbNewLine & vbNewLine & "Description:" & " " & [Description] & vbNewLine
Email_Subject = "Training dates"
olmail.display



On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.createitem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.cc = Email_Cc
.bcc = Email_Bcc
.Body = Email_Body

.send
End With
debugs:
If Err.Description <> "" Then MsgBox Err.Description



End If

[jonh]

Get the recordset from the form and cycle through the records. e.g.


Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
If rs.BOF And rs.EOF Then
MsgBox "no records"
Exit Sub
End If

rs.MoveFirst
shtm = "<p> Hello, here are the dates</p>"

Do Until rs.EOF
shtm = shtm & "<p>"
shtm = shtm & "<b>Title:</b> " & rs![Title] & "<br/>"
shtm = shtm & "<b>Location:</b> " & rs![Location] & "<br/>"
shtm = shtm & "<b>Start Time:</b> " & rs![Start Time] & "<br/>"
shtm = shtm & "<b>End Time:</b> " & rs![End Time] & "<br/>"
shtm = shtm & "<b>Description:</b> " & rs![Description]
shtm = shtm & "</p>"
shtm = shtm & vbCrLf
rs.MoveNext
Loop

[Arcadia]

Thanks for the vba code but when i click on the button it does noting :)

[jonh]

My code just builds the message body text. You need to add it to your own code.


Private Function MsgBodyHTML() As String

'*** MY CODE HERE ***

MsgBodyHTML = sHTM

End Function

Private Sub Send_Mail_Click()

Dim MsgBody As String
MsgBody = MsgBodyHTML
If MsgBody = "" Then Exit Sub

'*** YOUR CODE HERE >>>
'...
'...
olmail.HTMLBody = MsgBody
'...
'...

End Sub