Once again, trying to help someone out with a question in a forum lead to me creating the following function that I thought I’d share in case it could serve others. I can’t take credit for the base code, I merely cleaned it up substantially and switched it over to using Late Binding so it is more versatile.
The idea is simple, use a word document as the body of a new Outlook e-mail. So we need to open the document, copy its content, then start a new e-mail and paste in the content. Below is the resulting code.
'---------------------------------------------------------------------------------------
' Procedure : Outlook_GenEmailFromWordDoc
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Read a Word document and use it's content as an Outlook's e-mail body
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sDoc : Fully qualified path and filename with extension of the Word document
' to use as the content for the new Outlook e-mail
' sTo : To Recipient(s) email address(es) (semi-colon separated list)
' sSubject : Text to be used as the email subject line
' bEdit : True/False whether or not you wish to preview the email before sending
' sCC : CC Recipient(s) email address(es) (semi-colon separated list)
' sBCC : BCC Recipient(s) email address(es) (semi-colon separated list)
' AttachmentPath : Array of attachment (complete file paths with filename and extensions)
'
' Usage:
' ~~~~~~
' Call Outlook_GenEmailFromWordDoc("C:\Temp\Test.docx","someone@somewhere.com;someone2@somewhere.com", _
' "Test E-mail", True, "someone3@somewhere.com", _
' "someone4@somewhere.com", Array("C:\Temp\Test.xlsx"))
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2018-04-04 Initial Release
' 1 2018-04-05 Added more options
'---------------------------------------------------------------------------------------
Public Sub Outlook_GenEmailFromWordDoc(sDoc As String, _
ByVal sTo As String, _
ByVal sSubject As String, _
ByVal bEdit As Boolean, _
Optional sCC As Variant, _
Optional sBCC As Variant, _
Optional AttachmentPath As Variant)
On Error GoTo Error_Handler
'Word Declarations
Dim oWord As Object
Dim oWordDoc As Object
Dim oWordEditor As Object
Dim bWordWasRunning As Boolean
'Outlook Declarations
Dim oOutlook As Object
Dim oOutlookMail As Object
Dim oOutlookInsp As Object
Dim oOutlookRecip As Object
Dim oOutlookAttach As Object
Dim bOutlookWasRunning As Boolean
Dim bProbRecip As Boolean
Dim i As Long
' Const olFormatPlain = 1
' Const olFormatHTML = 2
' Const olFormatRichText = 3
Const olMailItem = 0
Const olTo = 1
Const olCC = 2
Const olBCC = 3
'Get/Start Word
On Error Resume Next
Set oWord = GetObject(, "Word.Application") 'Bind to existing instance
If Err.Number <> 0 Then 'Could not get instance, so create a new one
Err.Clear
Set oWord = CreateObject("Word.Application")
Else 'Was already running
bWordWasRunning = True
End If
On Error GoTo Error_Handler
Set oWordDoc = oWord.Documents.Open(sDoc) 'Open the document
oWordDoc.Content.Copy 'Copy its content
'Get/Start Outlook
On Error Resume Next
Set oOutlook = GetObject(, "Outlook.Application") 'Bind to existing instance
If Err.Number <> 0 Then 'Could not get instance, so create a new one
Err.Clear
Set oOutlook = CreateObject("Outlook.Application")
Else 'Was already running
bOutlookWasRunning = True
End If
On Error GoTo Error_Handler
Set oOutlookMail = oOutlook.CreateItem(olMailItem) 'Start a new e-mail
With oOutlookMail
.Display 'Had to move this command here to resolve a bug only existent in Access 2016!
'To Recipient(s)
Set oOutlookRecip = .Recipients.Add(sTo)
oOutlookRecip.Type = olTo
'CC Recipient(s)
If Not IsMissing(sCC) Then
Set oOutlookRecip = .Recipients.Add(sCC)
oOutlookRecip.Type = olCC
End If
'BCC Recipient(s)
If Not IsMissing(sBCC) Then
Set oOutlookRecip = .Recipients.Add(sBCC)
oOutlookRecip.Type = olBCC
End If
.Subject = sSubject 'Subject
Set oOutlookInsp = .GetInspector 'Retains the signature if applicable
.Importance = 1 'Importance Level 0=Low,1=Normal,2=High
' .BodyFormat = olFormatHTML
Set oWordEditor = .GetInspector.WordEditor
'oWordEditor.Content.Paste 'Overwrite any existing content, ie:signature
oWordEditor.Application.Selection.Start = 0
oWordEditor.Application.Selection.Paste
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
If IsArray(AttachmentPath) Then
For i = LBound(AttachmentPath) To UBound(AttachmentPath)
If AttachmentPath(i) <> "" And AttachmentPath(i) <> "False" Then
Set oOutlookAttach = .Attachments.Add(AttachmentPath(i))
End If
Next i
Else
If AttachmentPath <> "" And AttachmentPath(i) <> "False" Then
Set oOutlookAttach = .Attachments.Add(AttachmentPath)
End If
End If
End If
For Each oOutlookRecip In .Recipients
If Not oOutlookRecip.Resolve Then
bProbRecip = True
'Display msg to user?
End If
Next
If bProbRecip = False And bEdit = False Then 'Send the e-mail
.Send
End If
End With
Error_Handler_Exit:
On Error Resume Next
If Not oWordEditor Is Nothing Then Set oWordEditor = Nothing
If Not oOutlookRecip Is Nothing Then Set oOutlookRecip = Nothing
If Not oOutlookMail Is Nothing Then Set oOutlookMail = Nothing
If Not oOutlook Is Nothing Then Set oOutlook = Nothing
If Not oWordDoc Is Nothing Then
oWordDoc.Close
Set oWordDoc = Nothing
End If
If Not oWord Is Nothing Then
If bWordWasRunning = False Then oWord.Quit
Set oWord = Nothing
End If
Exit Sub
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: Outlook_GenEmailFromWordDoc" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Sub
Obviously, the procedure can be further expanded upon to take many more input variables, see http://www.devhut.net/2010/09/03/vba-send-html-emails-using-outlook-automation/ for a good sample of what I’m referring to (To, BCC, Subject, Attachments, …). The code would be the same, just copy/paste.