Sub Send_As_HTML_EMail()
'Graham Mayor - http://www.gmayor.com - Last updated - 14 Jul 2017
'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 oAccount As Object
Dim objDoc As Object
Dim objSel As Selection
Dim strRecipient As String
Dim strSubject As String
Dim strAccount As String

    strRecipient = "someone@somewhere.com"
    strSubject = "This is the message subject"
    strAccount = "account display name"

    ActiveDocument.Range.Copy
    Set olApp = OutlookApp()

    For Each oAccount In olApp.Session.Accounts
        If oAccount.DisplayName = strAccount Then
            Set oItem = olApp.CreateItem(0)
            With oItem
                Set .SendUsingAccount = oAccount
                .BodyFormat = 2
                .Display
                Set objDoc = .GetInspector.WordEditor
                Set objSel = objDoc.Windows(1).Selection
                objSel.PasteAndFormat Type:=wdFormatOriginalFormatting
                .To = strRecipient
                .Subject = strSubject
                '.Send
            End With
            Exit For
        End If
    Next oAccount
lbl_Exit:
    Set oItem = Nothing
    Set oAccount = Nothing
    Set olApp = Nothing
    Set objDoc = Nothing
    Set objSel = Nothing
    Exit Sub
End Sub