Option Explicit


Private Sub EmailData()
Dim OutApp As Object
Dim OutMail As Object
Dim OutInsp As Object
Dim OutDoc As Word.Document
Dim oFld As Word.FormField
Dim oRng As Word.Range
Dim oStart As Range

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "EmailAddressHere"
        .Subject = "SubjectHere"
        .Display
    End With

    Set OutInsp = OutMail.GetInspector
    Set OutDoc = OutInsp.WordEditor

    ActiveDocument.Content.Copy
    Set oStart = OutDoc.Range(Start:=0, End:=0)
    oStart.PasteAndFormat Type:=wdFormatOriginalFormatting
    For Each oFld In OutDoc.Range.FormFields
        Set oRng = oFld.Range
        If oFld.Type = wdFieldFormCheckBox Then
            If oFld.CheckBox.Value = True Then
                oRng.InsertSymbol _
                        Font:="Wingdings", _
                        CharacterNumber:=-3842, _
                        Unicode:=True
            Else
                oRng.InsertSymbol _
                        Font:="Wingdings", _
                        CharacterNumber:=-3985, _
                        Unicode:=True
            End If
        Else
            oRng.Text = oFld.Result
        End If
    Next oFld
    Set oFld = Nothing
    Set oRng = Nothing
    Set oStart = Nothing
    Set OutInsp = Nothing
    Set OutMail = Nothing
    Set OutDoc = Nothing
    Set OutApp = Nothing
End Sub