如何通过Excel VBA将单元格区域复制粘贴到Outlook邮件中？

你的代码无法完成粘贴操作的核心原因是变量名不匹配——你定义的邮件对象是pMail，但调用GetInspector.WordEditor时错误使用了未定义的OutMail，导致后续编辑操作全部失效。同时原代码的粘贴位置逻辑也会导致内容出现在邮件最开头，不符合预期。

以下是修正后的完整代码：

Sub Send_Email_Condition_Cell_Value_Change()
    Dim pApp As Object
    Dim pMail As Object
    Dim rng As Range
    Dim wdDoc As Object     ' Word.Document对象
    Dim wdRange As Object   ' Word.Range对象
    
    ' 指定要复制的Excel单元格区域
    Set rng = ThisWorkbook.ActiveSheet.Range("B6:C16")
    ' 初始化Outlook应用与邮件项
    Set pApp = CreateObject("Outlook.Application")
    Set pMail = pApp.CreateItem(0)
    
    On Error Resume Next
    With pMail
        .To = "@gmail.com"
        .CC = ""
        .BCC = ""
        .Subject = "BLANK Account Action Price Notification"
        ' 用HTML格式设置初始正文，确保Word编辑器可正常处理格式
        .HTMLBody = "<p>Hello, our recommended action price for BLANK has been hit.</p><br><p>Thank you.</p>"
        .Display ' 必须先显示邮件，才能获取Word编辑对象
        
        ' 获取邮件的Word编辑文档
        Set wdDoc = .GetInspector.WordEditor
        ' 将光标定位到正文末尾
        Set wdRange = wdDoc.Range(wdDoc.Content.End - 1, wdDoc.Content.End - 1)
        ' 插入换行分隔原有内容与表格
        wdRange.InsertAfter vbCrLf & vbCrLf
        ' 复制Excel区域并保留格式粘贴
        rng.Copy
        wdRange.PasteAndFormat 16 ' 16对应wdFormatOriginalFormatting，无需添加Word库引用
        
        '.Send ' 取消注释即可自动发送邮件
    End With
    On Error GoTo 0
    
    ' 释放对象资源
    Set wdRange = Nothing
    Set wdDoc = Nothing
    Set pMail = Nothing
    Set pApp = Nothing
End Sub

关键改动说明 #

1. 修正变量引用错误：将OutMail.GetInspector.WordEditor改为.GetInspector.WordEditor，在With块内直接通过.引用当前邮件对象pMail
2. 切换为HTML格式正文：替换原.Body为.HTMLBody，确保邮件以富文本模式打开，支持格式粘贴
3. 调整粘贴位置：将光标定位到正文末尾，避免粘贴内容覆盖原有文本或出现在开头
4. 保留格式粘贴：使用PasteAndFormat 16替代Paste，确保Excel单元格的边框、格式等能完整保留（若已添加Word对象库引用，也可直接写wdFormatOriginalFormatting）

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