使图像显示为内联是有可能的。 HTML中的 img src 必须使用图像的标识符引用 cid 。以下代码设置电子邮件，并将所有图表对象作为内联图像添加到电子邮件中。

Getting the images to appear as inline is certainly possible. The img src in the HTML must refer to the cid with an identifier for the image. The code below sets up the email and adds all of the chart objects as inline images to an email.

选项显式

Sub CreateEmail()
    Const PR_ATTACH_MIME_TAG = "http://schemas.microsoft.com/mapi/proptag/0x370E001E"
    Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim olApp As Object
    Dim olMail As Object
    Dim msg As String
    Dim msgGreeting As String
    Dim msgPara1 As String
    Dim msgEnding As String
    Dim chrt As ChartObject
    Dim fname As String
    Dim ident As String
    Dim tempFiles As Collection
    Dim imgIdents As Collection
    Dim imgFile As Variant
    Dim attchmt As Object
    Dim oPa As Object
    Dim i As Integer

    '--- create the email body with HTML-formatted content
    msgGreeting = "<bold>Dear Sirs</bold>,<br><br>"
    msgPara1 = "<div>Here is the data you requested:</div>"
    msgEnding = "<br><br>Sincerely,<br>JimBob<br>"

    '--- build the other email body content
    Set wb = ActiveWorkbook
    Set ws = ActiveSheet
    msg = msgGreeting & msgPara1
    '--- loops and adds all charts found on the worksheet
    If ws.ChartObjects.Count > 0 Then
        Set tempFiles = New Collection
        Set imgIdents = New Collection
        For Each chrt In ws.ChartObjects
            fname = ""
            msg = msg & ChartToEmbeddedHTML(chrt, fname, ident) & "<br><br>"
            tempFiles.Add fname
            imgIdents.Add ident
        Next chrt
    End If
    msg = msg & msgEnding

    '--- create the mail item
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0)                'olMailItem=0
    With olMail
        .To = "yyy@zzzz.com"
        '.CC = "xxxx@xxx"
        .Subject = "xxxx"
        .bodyformat = 2        'olFormatHTML=2
        '--- each of the images is referenced as a filename, but each one must be
        '    individually added as an attachment, then the attachment properties
        '    set to show the attachment as "inline". Because the image will be
        '    inlined, we'll use the "ident" as the reference (internal to the
        '    message body HTML)
        If (Not tempFiles Is Nothing) Then
            For i = 1 To tempFiles.Count
                Set attchmt = .attachments.Add(tempFiles.Item(i))
                Set oPa = attchmt.PropertyAccessor
                oPa.SetProperty PR_ATTACH_MIME_TAG, "image/png"
                oPa.SetProperty PR_ATTACH_CONTENT_ID, imgIdents.Item(i)
            Next i
        End If
        '--- the email item needs to be saved first
        .Save
        '--- now add the message contents
        .htmlbody = msg
        .display
    End With
    '--- delete the temp files now
    For Each imgFile In tempFiles
        Kill imgFile
    Next imgFile
    '--- clean up and get out
    Set tempFiles = Nothing
    Set imgIdents = Nothing
    Set attchmt = Nothing
    Set oPa = Nothing
    Set olMail = Nothing
    Set olApp = Nothing
    Set ws = Nothing
    Set wb = Nothing
End Sub

Private Function ChartToEmbeddedHTML(thisChart As ChartObject, _
                             ByRef tmpFile As String, _
                             ByRef ident As String) As String
    Dim html As String
    ident = RandomString(8)
    tmpFile = thisChart.Parent.Parent.Path & "\" & ident & ".png"

    thisChart.Activate
    thisChart.Chart.Export Filename:=tmpFile, Filtername:="png"
    html = "<img alt='Excel Chart' src='cid:" & ident & "'></img>"
    ChartToEmbeddedHTML = html
End Function

Private Function RandomString(strlen As Integer) As String
    Dim i As Integer, iTemp As Integer, bOK As Boolean, strTemp As String
    '48-57 = 0 To 9, 65-90 = A To Z, 97-122 = a To z
    'amend For other characters If required
    For i = 1 To strlen
        Do
            iTemp = Int((122 - 48 + 1) * Rnd + 48)
            Select Case iTemp
            Case 48 To 57, 65 To 90, 97 To 122: bOK = True
            Case Else: bOK = False
            End Select
        Loop Until bOK = True
        bOK = False
        strTemp = strTemp & Chr(iTemp)
    Next i
    RandomString = strTemp
End Function