The following should do that. You can replace the subject, the texts and the recipient as required:
Private Sub CommandButton4_Click()
Dim olApp As Object
Dim oMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
On Error Resume Next
If ActiveDocument.Tables.Count > 0 Then
ActiveDocument.Tables(1).Range.Copy
Set olApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set olApp = CreateObject("Outlook.Application")
End If
'On Error GoTo lbl_Exit
Set oMail = olApp.CreateItem(0)
With oMail
.to = "someone@somewhere.com"
.Subject = "Message Subject"
.BodyFormat = 2
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
.Display 'This line is required.
oRng.Text = "This is the text before the table." & vbCr & vbCr
oRng.Collapse 0
oRng.Paste
oRng.Collapse 0
oRng.Text = vbCr & "This is the text after the table, before the signature."
'.Send 'Restore this line to send the message
End With
Else
MsgBox "No table!"
End If
ActiveDocument.Tables(1).Cell(2, 1).Select
lbl_Exit:
Set olApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
End Sub