Option Explicit

Private Sub CommandButton1_Click()
Dim bStarted As Boolean
Dim olApp As Object
Dim oItem As Object
Dim oRng As Range
Dim objdoc As Object
Dim objSel As Selection
Dim bProtected As Boolean
    If IsOutlook Then
        On Error Resume Next
        If Not ActiveDocument.ProtectionType = wdNoProtection Then
            bProtected = True
            ActiveDocument.Unprotect Password:=""
        End If
        Set oRng = ActiveDocument.Range
        oRng.Copy
        'Get Outlook if it's running
        If bProtected = True Then
            ActiveDocument.Protect _
                    Type:=wdAllowOnlyFormFields, _
                    NoReset:=True, _
                    Password:=""
        End If
        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 = "someone@somewhere.com"
            .Subject = "Survey Form"
            .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
    Else
        MsgBox "Please return this form to someone@somewhere.com"
    End If
lbl_Exit:
    Exit Sub
End Sub

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