如何在Outlook邮件的两段HTML文本间插入Excel单元格区域？

问题描述 #

我编写VBA宏，想要把Excel单元格区域转成图片，插入到Outlook邮件的两段HTML文本之间，同时保留文本格式，但运行后图片位置不符合预期。

原代码 #

Sub sendEmailwithPic()

Dim OutApp As Object
Dim Outmail As Object
Dim table As Range
Dim pic As Picture
Dim ws As Worksheet
Dim wordDoc


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

'grab table, convert to image, and cut
Set ws = ThisWorkbook.Sheets("Sheet1")
Set table = ws.Range("A1:E11")
ws.Activate
table.Copy
Set pic = ws.Pictures.Paste
pic.Cut

'create email message
On Error Resume Next
    With Outmail
        .To = "someone@gmail.com"
        .Subject = "Country Population Data " & Format(Date, "mm-dd-yy")
        .Display
        
        
        Set wordDoc = Outmail.GetInspector.WordEditor
        wordDoc.Range.PasteandFormat wdChartPicture
        textStr1 = "<p><font style=font-size:11pt;font-family:Calibri><b>Lorem ipsum dolor sit amet, consectetur adipiscing elit</b></font></p>"
        textStr = "<body style=font-size:11pt;font-family:Calibri>" & _
                "<p><font style=font-size:11pt;font-family:Calibri><b>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
                "sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Vitae ultricies leo integer malesuada nunc.</b></p>" & _
                "<p><font style=font-size:9pt;font-family:Calibri>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
                "sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.</p>" & _
                "<p><font style=font-size:9pt;font-family:Arial;color:#595959><i>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
                "sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Amet consectetur adipiscing elit ut. Mattis aliquam faucibus purus in massa tempor." & _
                "Hendrerit dolor magna eget est.</i></font></p>"
        
        .HTMLBody = textStr1 & textStr
    End With
    On Error GoTo 0
    
Set OutApp = Nothing
Set Outmail = Nothing

End Sub

问题原因 #

1. 逻辑顺序错误：先通过WordEditor粘贴图片，随后设置.HTMLBody会完全替换邮件内容，导致之前粘贴的图片被覆盖，最终图片位置混乱。
2. 混合操作冲突：同时使用Word对象模型粘贴内容和直接设置HTMLBody，两种方式会互相干扰，无法保证内容位置准确。
3. 未正确嵌入图片到HTML：原代码没有将图片转换为HTML可识别的嵌入式资源，无法精准控制图片在文本中的位置。

修正后的代码 #

Sub sendEmailwithPic()
    Dim OutApp As Object
    Dim Outmail As Object
    Dim table As Range
    Dim picPath As String
    Dim ws As Worksheet
    Dim htmlBodyStr As String
    
    Set OutApp = CreateObject("Outlook.Application")
    Set Outmail = OutApp.CreateItem(0)
    
    ' 将Excel区域保存为临时图片文件
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set table = ws.Range("A1:E11")
    picPath = Environ("TEMP") & "\temp_table_image.png" ' 系统临时目录
    
    ' 复制区域为图片格式并保存到临时文件
    table.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    With ws.Shapes.AddPicture(picPath, False, True, 0, 0, table.Width, table.Height)
        .Name = "TempTablePic"
        .CopyPicture
        .Delete
    End With
    ' 调用画图程序保存剪贴板图片到临时文件
    Shell "mspaint.exe /p /s " & picPath, vbHide
    DoEvents
    
    ' 构建HTML内容，将图片插入到两段文本之间
    Dim textStr1 As String, textStr As String
    textStr1 = "<p><font style=""font-size:11pt;font-family:Calibri""><b>Lorem ipsum dolor sit amet, consectetur adipiscing elit</b></font></p>"
    textStr = "<p><font style=""font-size:11pt;font-family:Calibri""><b>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
              "sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Vitae ultricies leo integer malesuada nunc.</b></p>" & _
              "<p><font style=""font-size:9pt;font-family:Calibri"">Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
              "sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.</p>" & _
              "<p><font style=""font-size:9pt;font-family:Arial;color:#595959""><i>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
              "sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Amet consectetur adipiscing elit ut. Mattis aliquam faucibus purus in massa tempor." & _
              "Hendrerit dolor magna eget est.</i></font></p>"
    
    ' 拼接完整HTML：头部文本 + 图片标签 + 尾部文本
    htmlBodyStr = "<body style=""font-size:11pt;font-family:Calibri"">" & _
                  textStr1 & _
                  "<p><img src=""cid:temp_table_image"" style=""display:block;"" /></p>" & _
                  textStr & _
                  "</body>"
    
    ' 设置邮件内容并嵌入图片
    On Error Resume Next
    With Outmail
        .To = "someone@gmail.com"
        .Subject = "Country Population Data " & Format(Date, "mm-dd-yy")
        ' 添加临时图片为嵌入式附件，不显示为普通附件
        .Attachments.Add picPath, olByValue, 0
        .HTMLBody = htmlBodyStr
        .Display ' 显示邮件，如需直接发送可改为.Send
    End With
    On Error GoTo 0
    
    ' 删除临时文件
    Kill picPath
    
    Set OutApp = Nothing
    Set Outmail = Nothing
End Sub

修正说明 #

• 将Excel区域保存为临时图片，通过cid:协议嵌入HTML，确保图片能准确定位到两段文本之间。
• 统一使用HTML构建邮件内容，避免WordEditor和HTMLBody操作的冲突。
• 清理临时文件，避免系统残留。

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