使用VBA发送Excel区域截图至邮件时签名丢失问题求助

问题根源 #

你遇到的签名丢失，是因为代码中先通过WordEditor粘贴图片，之后直接赋值.HTMLBody，这会覆盖Outlook自动生成的包含签名的邮件内容；同时原代码的图片处理步骤冗余，也会增加出错概率。

修改后的代码 #

Sub send_email_with_table_as_pic()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim table As Range
    Dim ws As Worksheet
    Dim wordDoc As Object
    Dim signatureHTML As String ' 保存邮件签名的HTML内容

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

    ' 指定要截图的Excel区域
    Set ws = ThisWorkbook.Sheets("XXX")
    Set table = ws.Range("A1:J31")
    table.Copy ' 直接复制目标区域，无需转成工作表图片再剪切

    ' 初始化邮件并加载签名
    On Error Resume Next
    With OutMail
        .To = "xx@xxx.com"
        .Cc = "xx@xxx.com"
        .BCC = ""
        .Subject = "XXXXX " & Format(Now - 1, "mm-dd-yy")
        .Display ' 必须先执行Display，让Outlook自动加载签名
        
        ' 保存原始签名的HTML内容
        signatureHTML = .HTMLBody
        
        ' 将复制的表格粘贴为图片到邮件正文开头
        Set wordDoc = .GetInspector.WordEditor
        ' 若未引用Word对象库，将wdChartPicture替换为数值13
        wordDoc.Range(0, 0).PasteAndFormat wdChartPicture
        ' 在图片前添加提示文本
        wordDoc.Range(0, 0).InsertBefore "Hello, 请查看以下内容：" & vbCrLf & vbCrLf
        
        ' 合并正文内容与签名，避免覆盖
        .HTMLBody = wordDoc.Range.FormattedText & signatureHTML
    End With
    On Error GoTo 0

    ' 释放对象资源
    Set OutApp = Nothing
    Set OutMail = Nothing
    Set wordDoc = Nothing
End Sub

关键修改说明 #

1. 先加载并保存签名：调用.Display触发Outlook加载签名，提前保存签名的HTML内容，避免后续操作丢失签名
2. 简化图片处理流程：直接复制Excel区域，跳过粘贴成工作表图片再剪切的步骤，减少冗余操作
3. 正确合并内容与签名：通过WordEditor编辑正文后，将格式化的正文内容与保存的签名HTML合并，确保签名保留在邮件末尾
4. 兼容无Word引用场景：如果未引用Microsoft Word对象库，将wdChartPicture替换为数值13即可正常运行

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