Private Sub CommandButton1_Click()
'Graham Mayor - https://www.gmayor.com - Last updated - 27 Apr 2020
Dim OL As Object
Dim olInsp As Object
Dim EmailItem As Object
Dim Doc As Document
Dim wdDoc As Document
Dim oRng As Range
Dim strPath As String
    strPath = Environ("TEMP") & "\Filename.docx" 'change name as required

    Application.ScreenUpdating = False
    Set OL = CreateObject("Outlook.Application")
    Set EmailItem = OL.CreateItem(0)
    Set Doc = ActiveDocument
    Doc.SaveAs2 FileName:=strPath, FileFormat:=12, AddToRecentFiles:=False

    With EmailItem
        .Subject = "ENTER SUBJECT LINE HERE"
        .To = "ENTER RECIPIENT EMAIL HERE"
        '.CC = "ENTER A CC EMAIL ADDRESS AND REMOVE COMMENT OUT TO MAKE LIVE"
        .Importance = 2

        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.Collapse 1
        .Display 'This line is required
        oRng.Text = "ENTER MESSAGE HERE"    '& vbCrLf & _
                                            '"BODY SECND LINE" & vbCrLf & _
                                            '"BODY THIRD LINE"
        .Attachments.Add strPath
        .Send
    End With
    Doc.Close 0
    Kill strPath
    Application.ScreenUpdating = True
    Set OL = Nothing
    Set EmailItem = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
End Sub