如何在Outlook邮件正文下方插入Excel单元格区域？解决.Body覆盖问题

核心问题是设置.Body属性会完全替换邮件的现有内容，导致之前通过Paste插入的Excel表格被覆盖。因为.Body是直接赋值整个邮件正文，而非追加内容。以下是两种可行的解决方案：

方案1：先写入正文文本，再粘贴Excel表格到末尾 #

调整操作顺序，先通过Word编辑器写入正文，再定位到正文末尾粘贴表格，避免覆盖。修改后的代码如下：

Sub TryExcel()
    Dim myXL As Excel.Application
    Dim wb As Excel.Workbook
    Dim myMail As MailItem
    Dim wordDoc As Word.Document
    Dim targetRng As Word.Range

    ' 绑定已运行的Excel实例和目标工作簿
    Set myXL = GetObject(, "Excel.Application")
    Set wb = myXL.Workbooks("Sheet1.xlsm")
  
    ' 刷新数据并复制目标单元格区域
    wb.RefreshAll
    wb.Worksheets("1").Range("A1:D4").Copy
    
    ' 创建新邮件
    Set myMail = ThisOutlookSession.CreateItem(olMailItem)
    With myMail
        .Display ' 必须先Display才能获取Word编辑器
        .To = "*******.com"
        .Importance = olImportanceHigh
        .Subject = "<输入邮件主题>"
        .BodyFormat = olFormatHTML
        
        ' 获取邮件的Word编辑文档
        Set wordDoc = .GetInspector.WordEditor
        ' 写入正文文本，末尾加两个换行分隔表格
        wordDoc.Range.Text = "<输入邮件正文内容>" & vbCrLf & vbCrLf
        
        ' 定位到文档末尾
        Set targetRng = wordDoc.Range(wordDoc.Content.End - 1, wordDoc.Content.End - 1)
        ' 粘贴Excel表格
        targetRng.Paste
        
        '.Send ' 按需启用发送
    End With

    ' 释放对象
    Set targetRng = Nothing
    Set wordDoc = Nothing
    Set myMail = Nothing
    Set wb = Nothing
    Set myXL = Nothing
End Sub

方案2：先粘贴Excel表格，再在表格上方插入正文 #

如果需要先粘贴表格，再在顶部添加正文，可以通过定位到文档开头插入文本：

Sub TryExcel()
    Dim myXL As Excel.Application
    Dim wb As Excel.Workbook
    Dim myMail As MailItem
    Dim wordDoc As Word.Document
    Dim targetRng As Word.Range

    Set myXL = GetObject(, "Excel.Application")
    Set wb = myXL.Workbooks("Sheet1.xlsm")
  
    wb.RefreshAll
    wb.Worksheets("1").Range("A1:D4").Copy
    
    Set myMail = ThisOutlookSession.CreateItem(olMailItem)
    With myMail
        .Display
        .To = "*******.com"
        .Importance = olImportanceHigh
        .Subject = "<输入邮件主题>"
        .BodyFormat = olFormatHTML
        
        ' 先粘贴Excel表格
        .GetInspector.WordEditor.Range.Paste
        
        ' 获取Word文档对象，定位到开头
        Set wordDoc = .GetInspector.WordEditor
        Set targetRng = wordDoc.Range(0, 0)
        ' 在开头插入正文，末尾加两个换行分隔表格
        targetRng.Text = "<输入邮件正文内容>" & vbCrLf & vbCrLf
        
        '.Send
    End With

    ' 释放对象
    Set targetRng = Nothing
    Set wordDoc = Nothing
    Set myMail = Nothing
    Set wb = Nothing
    Set myXL = Nothing
End Sub

关键说明 #

• 必须先调用.Display方法，才能获取邮件的WordEditor对象（未显示的邮件没有激活的编辑器实例）。
• 使用Word的Range对象操作正文，可精准控制文本和表格的位置，避免直接赋值.Body/.HTMLBody导致的内容覆盖。
• 若使用早期绑定，需确保已添加Microsoft Word xx.x Object Library的引用（在VBA编辑器的「工具」→「引用」中勾选）。

内容的提问来源于stack exchange，提问作者Donzell