Option Explicit

Sub Send_As_Mail_Attachment()
'Graham Mayor - https://www.gmayor.com - Last updated - 21 Jul 2019
'Send the document as an attachment in an Outlook Email message
'Requires the code from - http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to either retrieve an open instance of Outlook or open Outlook if it is closed.
Dim bStarted As Boolean
Dim olApp As Object
Dim oItem As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim oDoc As Document
Dim strName As String
Dim oCC As ContentControl
Dim strSubject As String

    Set oDoc = ActiveDocument
    On Error GoTo err_Handler:
    oDoc.Save
    Set oCC = oDoc.SelectContentControlsByTitle("Subject").Item(1)
    If oCC.ShowingPlaceholderText = False Then
        strSubject = oCC.Range.Text
    Else
        strSubject = "Default subject text"
    End If
    strName = oDoc.FullName
    'Get Outlook if it's running
    Set olApp = OutlookApp()
    'Create a new mailitem
    Set oItem = olApp.CreateItem(0)

    With oItem
        .Display
        .To = "someone@somewhere.com"
        .Subject = strSubject
        .Attachments.Add strName
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.Collapse 1
        oRng.Text = "Complete the attached form and return to sender."
        '.Send 'Restore line after testing
    End With

lbl_Exit:
    Set oItem = Nothing
    Set olApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oDoc = Nothing
    Set oRng = Nothing
    Exit Sub
err_Handler:
    Err.Clear
    GoTo lbl_Exit
End Sub