将 Excel 范围作为图像嵌入到 Outlook 邮件中

Question

我之前使用 Ron De Bruin RangetoHTML 函数将 Excel 范围作为图像嵌入到 Outlook 邮件中。新的信任中心设置禁止这样做，我无法更改它们。

我切换到 MailEnvelope，但某些安全设置再次阻止了这种情况。

.Display

有时会起作用，但并非始终如一。

我现在正在寻找一种解决方案，将范围作为图片附加到电子邮件正文。我无法让图像显示在正文中。

我可以添加为附件。将 0 更改为 1 会附加物理文件。

.Attachments.Add strTempFilePath, olByValue, 0

运行 Windows 11 和 Office 365。

Sub a()
Call Create_Email("[email protected]", "test2")
End Sub

Sub Create_Email(ByVal strTo As String, ByVal strSubject As String)

    Dim rngToPicture As Range
    Dim outlookApp As Object
    Dim Outmail As Object
    Dim strTempFilePath As String
    Dim strTempFileName As String

    'Name it anything, doesn't matter
    strTempFileName = "RangeAsPNG"

    'rngToPicture is defined as NAMED RANGE in the workbook, do modify this name before use
    Set rngToPicture = Range("A1:D30")
    Set outlookApp = CreateObject("Outlook.Application")
    Set Outmail = outlookApp.CreateItem(olMailItem)

    'Create an email
    With Outmail
        .To = strTo
        .Subject = strSubject

        'Create the range as a PNG file and store it in temp folder
        Call createPNG(rngToPicture, strTempFileName)

        'Embed the image in Outlook
        strTempFilePath = Environ$("temp") & "\" & strTempFileName & ".png"
        .Attachments.Add strTempFilePath, olByValue, 0
        .HTMLBody = "Hello"
        .Display
    End With

    Set Outmail = Nothing
    Set outlookApp = Nothing
    Set rngToPicture = Nothing

End Sub

Sub createPNG(ByRef rngToPicture As Range, nameFile As String)

    Dim wksName As String

    wksName = rngToPicture.Parent.Name

    'Delete the existing PNG file of same name, if exists
    On Error Resume Next
        Kill Environ$("temp") & "\" & nameFile & ".png"
    On Error GoTo 0

    'Copy the range as picture
    rngToPicture.CopyPicture

    'Paste the picture in Chart area of same dimensions
    With ThisWorkbook.Worksheets(wksName).ChartObjects.Add(rngToPicture.Left, rngToPicture.Top, rngToPicture.Width, rngToPicture.Height)
        .Activate
        .Chart.Paste
        'Export the chart as PNG File to Temp folder
        .Chart.Export Environ$("temp") & "\" & nameFile & ".png", "PNG"
    End With
    
    Worksheets(wksName).ChartObjects(Worksheets(wksName).ChartObjects.Count).Delete

End Sub

Answer 1

您的 HTML 正文甚至不引用图像 - 您需要一个

<img>

标签，并且它需要通过

src=cid:

属性和附件本身设置的 content-id 属性来引用作为附件添加的图像。请参阅https://stackoverflow.com/a/72017591/332059