Option Explicit
Private Sub CommandButton1_Click()
Send_As_HTML_EMail
End Sub

Sub Send_As_HTML_EMail()
'Graham Mayor - www.gmayor.com
Dim bStarted As Boolean
Dim olApp As Object
Dim oItem As Object
Dim orng As Range
Dim objdoc As Object
Dim objSel As Selection
    On Error Resume Next
    Set orng = ActiveDocument.Range
    orng.Copy
    'Get Outlook if it's running
    Set olApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        'Outlook wasn't running, start it from code
        Set olApp = CreateObject("Outlook.Application")
        bStarted = True
    End If
    'Create a new mailitem
    Set oItem = olApp.CreateItem(0)
    With oItem
        .BodyFormat = 2
        .Display
        Set objdoc = .GetInspector.WordEditor
        Set objSel = objdoc.Windows(1).Selection
        objSel.Paste
        .to = "test@mail.com"
        .Subject = "The subject"
        .Send
    End With
    If bStarted Then
        'If we started Outlook from code, then close it
        olApp.Quit
    End If
    'Clean up
    Set oItem = Nothing
    Set olApp = Nothing
lbl_Exit:
    Exit Sub
End Sub