The following macro will do all of that. Ensure that you change the three lines at the top for the fixed values before running the macro.
Option Explicit
Sub SendOnMessageasAttachment()
Dim olItem As Outlook.MailItem
Dim olOutMail As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Const sAddr As String = "someone@somewhere.com" ' the recipient
Const sSubj As String = "This is the message subject"
Const sText As String = "This is the covering message text"
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox "No Items selected!", vbCritical, "Error"
Exit Sub
End If
Set olOutMail = CreateItem(olMailItem)
With olOutMail
.To = sAddr
.subject = sSubj
For Each olItem In Application.ActiveExplorer.Selection
.Attachments.Add olItem
Next olItem
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
oRng.Text = sText
.Display 'This line essential
'.Send 'Remove the apostrophe from the start of the line after testing.
End With
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
lbl_Exit:
Set olItem = Nothing
Set olOutMail = Nothing
Exit Sub
End Sub