如何用VBA将Word文档内容粘贴至Outlook邮件正文

已实现Excel自动填充Word模板内容，需要将完整Word文档内容复制粘贴到Outlook邮件正文，但原代码中的粘贴语句无法正常工作，寻求正确实现方式。

原代码 #

Dim OutApp As Object, OutMail As Object, wdApp As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set wdApp = CreateObject("Word.Application")

Dim Team As String
Dim row As String
Dim Championship As String
Dim Subject As String
Dim Race As String
Dim Location As String
Dim Doc As Object

...

With wdApp.Selection
        
        .GoTo What:=-1, Name:="Name"
        .TypeText (Team)
        
        .GoTo What:=-1, Name:="Race"
        .TypeText (Race)
        
        .GoTo What:=-1, Name:="Location"
        .TypeText (Location)
        
        .WholeStory
        .Copy
        
    End With

With OutMail

    .To = "email"
    .Subject = Subject
    .Body = OutApp.Paste
    .Display
    
End With

Set OutApp = Nothing
Set OutMail = Nothing

问题分析与解决方法 #

• 原代码中.Body = OutApp.Paste的错误在于：.Body仅支持纯文本内容，且OutApp.Paste的调用方式不正确，无法直接将剪贴板内容赋值给邮件正文。
• 要保留Word内容的格式，需借助Outlook邮件内置的Word编辑器完成粘贴操作，步骤如下：
  1. 先调用.Display方法打开邮件窗口，确保邮件的Word编辑器已初始化。
  2. 获取邮件的Inspector.WordEditor对象，通过该对象执行粘贴操作。
  3. 确保Word文档内容已正确复制到剪贴板（原代码中的.WholeStory.Copy部分是正确的）。

修正后的完整代码 #

Dim OutApp As Object, OutMail As Object, wdApp As Object
Dim Doc As Object
Dim Team As String, Race As String, Location As String, Subject As String

' 初始化应用对象
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set wdApp = CreateObject("Word.Application")
' 打开Word模板（需替换为你的模板路径）
Set Doc = wdApp.Documents.Open("C:\YourTemplatePath\Template.docx")

' 填充Word模板内容（此处省略变量赋值逻辑，需自行补充）
With wdApp.Selection
    .GoTo What:=-1, Name:="Name"
    .TypeText Team
    
    .GoTo What:=-1, Name:="Race"
    .TypeText Race
    
    .GoTo What:=-1, Name:="Location"
    .TypeText Location
    
    .WholeStory
    .Copy
End With

' 配置并生成邮件
With OutMail
    .To = "email@example.com"
    .Subject = Subject
    .Display ' 必须先打开邮件窗口，才能获取Word编辑器
    
    ' 获取邮件的Word编辑器并粘贴内容
    Dim mailWordEditor As Object
    Set mailWordEditor = .Inspector.WordEditor
    mailWordEditor.Content.Paste
End With

' 释放对象并关闭Word文档
Doc.Close SaveChanges:=False ' 根据需求选择是否保存模板修改
wdApp.Quit
Set Doc = Nothing
Set wdApp = Nothing
Set OutMail = Nothing
Set OutApp = Nothing

额外说明 #

• 如果不需要保留格式，仅需纯文本内容，可以使用OutMail.Body = wdApp.ActiveDocument.Content.Text直接赋值，无需复制粘贴。
• 确保Word模板中的书签名称（如"Name"、"Race"）与代码中的名称完全一致，否则填充内容会失败。

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