ActiveWindow.EnvelopeVisible = True

Option Explicit

Sub Send_As_HTML_EMail()
Dim bStarted As Boolean
Dim olApp As Object
Dim oItem As Object
Dim orng As Range
Dim objdoc As Object
Dim objSel As Selection
Const sRecipient As String = "someone@somewhere.com"    'The address to which the form is to be sent
Const sSubject As String = "The message subject"

    If IsOutlook = False Then
        MsgBox "It appears that you do not have Outlook available to return the form." & vbCr & vbCr & _
               "Please save and attach the completed form to a new e-mail message using your normal e-mail application and return it to " & _
               sRecipient, vbCritical, "Outlook not available"
        GoTo lbl_Exit
    End If
    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 = sRecipient
        .Subject = sSubject
        .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

Public Function IsOutlook() As Boolean
    On Error Resume Next
    IsOutlook = (Not CreateObject("Outlook.Application") Is Nothing)
lbl_Exit:
    Exit Function
End Function