Excel VBA实现邮件正文插入单元格文本与数据透视表的问题

问题核心是你原代码用.Body设置纯文本后，在开头粘贴表格会覆盖内容，且.Body无法保留格式。改用Word编辑器对象分步插入文本和表格即可解决，具体方案如下：

修改思路 #

• 放弃.Body纯文本设置，直接通过Word对象插入E19的动态文本
• 插入文本后将光标移至文档末尾，再粘贴透视表内容，确保文本在前、表格在后
• 采用后期绑定避免引用Word库，保证代码兼容性

修改后的完整代码 #

Sub MailSoir()
    Dim OutApp As Object
    Set OutApp = CreateObject("Outlook.Application")

    Dim OutMail As Object
    Set OutMail = OutApp.CreateItem(0)

    Dim oObjetWord As Object
    Dim ws As Worksheet
    Set ws = Worksheets("Soir") ' 定义工作表对象，简化代码调用

    With OutMail
        .To = ws.Range("E10").Value
        .CC = ws.Range("E13").Value
        .Subject = ws.Range("E16").Value
        
        ' 必须先调用.Display，才能获取Word编辑器对象
        .Display
        Set oObjetWord = .GetInspector.WordEditor
        
        ' 1. 插入E19的动态文本到邮件正文
        oObjetWord.Content.Text = ws.Range("E19").Value
        
        ' 2. 将光标移到文档末尾（6对应Word的wdStory常量，后期绑定用数值替代）
        oObjetWord.Application.Selection.EndKey 6
        
        ' 3. 插入空行，优化文本与表格的排版（可选，按需删除）
        oObjetWord.Application.Selection.TypeParagraph
        
        ' 4. 复制并粘贴透视表内容
        ' 建议明确指定透视表，比Selection更稳定，替换成你实际的透视表名称
        ws.PivotTables("你的透视表名称").TableRange1.Copy
        ' 如果坚持用当前选中内容，保留下面这句即可：
        ' Selection.Copy
        oObjetWord.Application.Selection.Paste
        
        ' 清理剪贴板（可选）
        Application.CutCopyMode = False
    End With

    ' 释放对象
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set oObjetWord = Nothing
    Set ws = Nothing
End Sub

关键细节说明 #

1. 提前调用.Display：只有邮件显示后，才能正常获取WordEditor对象，这是常见的踩坑点
2. 光标定位到末尾：避免粘贴时覆盖已插入的文本，确保顺序正确
3. 明确指定透视表范围：Selection.Copy依赖当前选中状态，容易出错，用PivotTables("名称").TableRange1能精准定位透视表区域
4. 可选排版优化：TypeParagraph会在文本和表格之间添加空行，让邮件正文更美观，不需要可直接删除

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