Maybe something like
Option Explicit
Private Sub Macro1()
'Graham Mayor - https://www.gmayor.com - Last updated - 29 Nov 2022
'This macro requires the code from the following link to open Outlook correctly
'http://www.rondebruin.nl/win/s1/outlook/openclose.htm
Dim olApp As Object
Dim oMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oDoc As Document
Dim oRng As Object
Dim lngTable As Long
Dim oBM As Bookmark
On Error Resume Next
If ActiveDocument.Tables.Count > 4 Then
Set oDoc = ActiveDocument
oDoc.Save
Set olApp = OutlookApp()
On Error GoTo 0
Set oMail = olApp.CreateItem(0)
With oMail
.to = "someone@somewhere.com"
.Subject = oDoc.Name
.BodyFormat = 2
.Attachments.Add oDoc.FullName
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 tables." & vbCr & vbCr
oRng.Collapse 0
For lngTable = 1 To 9
If lngTable = 1 Then
oDoc.Tables(lngTable).Range.Copy
oRng.Paste
oRng.Collapse 0
oRng.Text = "Table " & lngTable & vbCr
oRng.Collapse 0
End If
If lngTable = 2 Then
oDoc.Tables(lngTable).Range.Copy
oRng.Paste
oRng.Collapse 0
oRng.Text = "Table " & lngTable & vbCr
oRng.Collapse 0
End If
If lngTable = 8 Then
oDoc.Tables(lngTable).Range.Copy
oRng.Paste
oRng.Collapse 0
oRng.Text = "Table " & lngTable & vbCr
oRng.Collapse 0
End If
If lngTable = 9 Then
oDoc.Tables(lngTable).Range.Copy
oRng.Paste
oRng.Collapse 0
oRng.Text = "Table " & lngTable & vbCr
oRng.Collapse 0
End If
Next lngTable
oRng.Text = vbCr & "This is the text after the tables, before the signature."
End With
'.Send 'Restore this line to send the message
Else
MsgBox "No tables!"
End If
lbl_Exit:
Set olApp = Nothing
Set oDoc = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
End Sub