Option Explicit

Sub Send_As_Attachment()
'Graham Mayor - https://www.gmayor.com - Last updated - 09 Jul 2019
Dim olItem As MailItem
Dim olInsp As Inspector
Dim wdDoc As Object
Dim oRng As Object
    'Change the values below as appropriate
Const strSubject As String = "This is the message subject"
Const strRecipient As String = "someone@somewhere.com"
Const strMessage As String = "This is the message body text" & vbCr & vbCr & _
      "This is another paragraph of message body"

    Set olItem = CreateItem(0)
    With olItem
        .BodyFormat = 2
        .To = strRecipient
        .Subject = strSubject
        .Attachments.Add BrowseForFile
        .Display
        Set olInsp = olItem.GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.collapse 1
        oRng.Text = strMessage
        '.Send
    End With
lbl_Exit:
    Set olItem = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

Function BrowseForFile(Optional sName As String) As String
Dim exApp As Object
Dim strPath As String: strPath = ""
Dim fDialog As FileDialog
Dim bStarted As Boolean
    On Error Resume Next
    Set exApp = GetObject(, "Excel.Application")
    On Error GoTo 0
    If exApp Is Nothing Then
        Set exApp = CreateObject("Excel.Application")
        bStarted = True
    End If

    Set fDialog = exApp.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .Title = "Select attachment"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then GoTo err_Handler:
        BrowseForFile = fDialog.SelectedItems.Item(1)
    End With
lbl_Exit:
    If bStarted = True Then exApp.Quit    'Optional
    Set exApp = Nothing
    Exit Function
err_Handler:
    BrowseForFile = vbNullString
    Resume lbl_Exit
End Function