MS Access – Use Word Document As Outlook E-mail Body

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.

CreateObject(“Outlook.Application”) Does Not Work!
In some cases CreateObject(“Outlook.Application”) does not work, don’t ask me why (it’s a Microsoft thing!). Luckily for you, a while back I was faced with this headache and came up with a solution that has never failed me to date (I should never have said those words, I know!). So if you are faced with this issue, take a look at http://www.devhut.net/2014/10/31/createobjectoutlook-application-does-not-work-now-what/.