图片未显示在电子邮件中答案

【问题标题】：Image doesn't show in email图片未显示在电子邮件中
【发布时间】：2020-10-19 08:58:30
【问题描述】：

我正在尝试通过 Outlook 发送带有两个附件（一个徽标和一个签名图片）的批量电子邮件。

当我.send 时，图像不会显示在收到的电子邮件中。
它们确实显示，如果我首先使用 .display 然后手动发送。

Sub GenerateEMail()

'set abbreviations for workbook and sheets
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsInput As Worksheet: Set wsInput = wb.Sheets("Input")
Dim wsTool As Worksheet: Set wsTool = wb.Sheets("Tool")
Dim outObj As Object
Dim Mail As Object
Set outObj = CreateObject("Outlook.Application")

'Dim olkPA As Outlook.PropertyAccessor
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001F"

'Fasten Macro
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

'get information from sheet "Tool"
'E-Mail
Subject = wsTool.Range("Subjet").Value
Text = wsTool.Range("Text").Value

'Signatures
Signature = wsTool.Range("Sig").Value & "\" & wsTool.Range("NameSig").Value

'Logo
Logo = wsTool.Range("Logo").Value & "\" & wsTool.Range("NameLogo").Value

'get relevant columns from sheet "Input"
ColEMail = Split(Cells(1, Application.WorksheetFunction.Match(wsTool.Range("ColNameMail"), wsInput.Range("1:1"), 0)).Address, "$")(1)

'generate E-Mail for each line (range defined in wsTool)

firstRow = wsTool.Range("From").Value
If wsTool.Range("To").Value <> "" And wsTool.Range("To").Value <> " " Then
    lastRow = wsTool.Range("To").Value
Else
    lastRow = wsInput.Cells(wsInput.Rows.Count, "A").End(xlUp).Row
End If

For Line = firstRow To lastRow
    
    'opens additional E-Mail
    Set Mail = outObj.createitem(0)
    Set olkPA = Mail.PropertyAccessor

    olkPA.SetProperty PR_ATTACH_CONTENT_ID, "Signature.png"
    olkPA.SetProperty PR_ATTACH_CONTENT_ID, "Logo.png"




        .Subject = Subject

        '.
        'Body with Foto of Signatures & Logo
        .HTMLBody = "<img src='" & Logo & "'>" & "<br><br>" & _
               
         Text & "<br>" & _
    
         "<img src='" & Signature & "'>" 

        .To = wsInput.Range(ColEMail & Line).Value

    End With

    Mail.send
    
Next Line

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

End Sub

【问题讨论】：

标签： excel vba image email outlook

【解决方案1】：

您正在邮件本身上设置PR_ATTACH_CONTENT_ID 属性 - 您必须添加附件 (MailItem.Attachments.Add)，然后将返回的 Attachment 对象上的 PR_ATTACH_CONTENT_ID 属性设置为与 img 上的 cid 属性匹配的值标记。

【讨论】：