ExcelからOutlookでメールを作成し、テーブルを貼り付けた後に自動調整するマクロ 関連Tweet：https://twitter.com/kinuasa/status/1495570001482612741

PasteTableToMail.vb

Option Explicit

Public Sub PasteTableToMail()
  Dim appOl As Object 'Outlook.Application
  On Error Resume Next
  Set appOl = GetObject(, "Outlook.Application")
  On Error GoTo 0
  If appOl Is Nothing Then Exit Sub
  
  Dim itm As Object 'Outlook.MailItem
  Dim ins As Object 'Outlook.Inspector
  Const olMailItem = 0
  Set itm = appOl.CreateItem(olMailItem)
  With itm
    .Display
    Set ins = .GetInspector
  End With
  
  'WordEditor(Word.Document)経由で本文装飾
  Dim rng As Object 'Word.Range
  Const olEditorWord = 4
  Const wdAutoFitWindow = 2
  If ins.EditorType = olEditorWord Then '念のため判定
    With ins.WordEditor
      ActiveSheet.ListObjects(1).Range.Copy 'アクティブシートのテーブルコピー
      '以降Word VBA参考
      'Set rng = .Application.Selection.Range
      Set rng = .Range(0, 0)
      rng.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
      rng.Tables(1).AutoFitBehavior wdAutoFitWindow 'ウィンドウサイズに合わせて自動調整
    End With
  End If
End Sub

画面イメージ.md