Exporting from Access to Populate a Draft Email

[swimmermx]

Here's my situation: I'm creating a database in Access and would like to click a command that would export data from tables into a draft email that could be saved or whatever. Is this possible?

Thanks!

[pbaldy]

Sure. You can use SendObject in VBA to create the email. If the built-in options to send a query, report, etc don't work in your situation, you can open a recordset to get the data, or use a form if the data necessary is already displayed there.

[swimmermx]

ok thanks a lot!

[pbaldy]

No problem; post back if you get stuck.

[swimmermx]

Okay, so I need more help.

I'm trying to create a draft email and populate it with variables from the DB. Right now, I have a Word doc that includes bookmarks that will be replaced by variables in Access. But when I transfer over the word document into the body of the email, it doesn't copy all the bold/other formatting. Any idea how to fix this or a better way to do this? Does outlook have bookmarks that work for all versions of outlook?

Here's my partial code:

Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim TheAddress As String
Dim strSQL As String

'----------------------------------------------------------------------------------------------------------

Set MyDB = CurrentDb
strSQL = "SELECT * FROM tbl_Approvers INNER JOIN tbl_Approvals ON tbl_Approvers.Approver = tbl_Approvals.Approver " _
& "WHERE tbl_Approvals.CRNumber= " & Me.CRNumber & ""

Set MyRS = MyDB.OpenRecordset(strSQL)

MyRS.MoveFirst

'----------------------------------------------------------------------------------------------------------
'Open up word template and replace all bookmarks with existing data

DoCmd.SetWarnings False

Dim Wrd As New Word.Application
Set Wrd = CreateObject("Word.Application")

Dim MergeDoc As String
MergeDoc = Application.CurrentProject.Path
MergeDoc = MergeDoc & "\ApprovalEmail.doc"

Wrd.Documents.Add MergeDoc
Wrd.Visible = True

'Replace all bookmarks from the Word template
With Wrd.ActiveDocument.Bookmarks
.Item("FirstName").Range.Text = MyRS![tbl_Approvals.Approver]
End With

'----------------------------------------------------------------------------------------------------------
'This is where I'm trying to copy everything from word into the body

' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

Do Until MyRS.EOF
' Create the e-mail message.
TheAddress = MyRS!Email

With objOutlookMsg
' Add the To recipients to the e-mail message.
Set objOutlookRecip = .Recipients.Add(TheAddress)
objOutlookRecip.Type = olTo

' Add the Cc recipients to the e-mail message.
If IsNull((MyRS!CC)) Then
Else
Set objOutlookRecip = .Recipients.Add(MyRS!CC)
objOutlookRecip.Type = olCC
End If

' Set the Subject, the Body, and the Importance of the e-mail message.
'''.Subject = Forms!
.Body = Wrd.ActiveDocument.Range


.Importance = olImportanceHigh 'High importance
.VotingOptions = "Approve;Reject"

'''''' 'Add the attachment to the e-mail message.
'''''' If Not IsMissing(AttachmentPath) Then
'''''' Set objOutlookAttach = .Attachments.Add(AttachmentPath)
'''''' End If

' Resolve the name of each Recipient.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
''''' .Send
.Display
End With
MyRS.MoveNext
Loop
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
DoCmd.SetWarnings True

Thanks for any help!

[pbaldy]

I've never automated Word, so I'm not sure what's going to be coming over. You can try using:

.HTMLBody

instead of

.Body

and see if that brings in the formatting.