如何在 Outlook 2010 中将嵌入图像添加到 HTML 邮件答案

【问题标题】：How to add an embedded image to an HTML message in Outlook 2010如何在 Outlook 2010 中将嵌入图像添加到 HTML 邮件
【发布时间】：2011-09-07 15:51:54
【问题描述】：

我有 Office 2003 VBA 代码，它使用 the technique described here 使用未记录的 MAPI 属性和 CDO 1.21 在 HTML 消息中嵌入图像。

CDO 1.21 不再受支持，但according to MSDN，其大部分功能现在已合并到 Outlook 2010 对象模型中。

在哪里可以找到使用 Outlook 2010 对象模型在 Outlook 2010 邮件中嵌入图像的示例？

【问题讨论】：

标签： vba outlook cdo.message outlook-object-model

【解决方案1】：

找到答案here。

关键位是：

Const PR_ATTACH_MIME_TAG = "http://schemas.microsoft.com/mapi/proptag/0x370E001E"        
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"        
Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B" 

...

Set colAttach = l_Msg.Attachments        
For x = 1 To Items.Count            
    Set l_Attach = colAttach.Add(Items.Item(x))            
    Set oPA = l_Attach.PropertyAccessor            
    oPA.SetProperty PR_ATTACH_MIME_TAG, ItemTypes.Item(x)            
    oPA.SetProperty PR_ATTACH_CONTENT_ID, "item" & x            
    oPA.SetProperty PR_ATTACHMENT_HIDDEN, True        
Next

【讨论】：

【解决方案2】：

这里是另一个例子：

Option Explicit
'Add reference to MS Outlook x.x Object Library
'Picture to be added as an attachment and modified src location for each embedded picture.
Private Sub Command1_Click()

    Dim oApp As Outlook.Application
    Dim oEmail As MailItem
    Dim colAttach As Outlook.Attachments
    Dim oAttach As Outlook.Attachment

    'create new Outlook MailItem
    Set oApp = CreateObject("Outlook.Application")
    Set oEmail = oApp.CreateItem(olMailItem)
    'add graphic as attachment to Outlook message
    'change path to graphic as needed
    Set colAttach = oEmail.Attachments
    Set oAttach = colAttach.Add("D:\my documents\[color=red]MyPic.jpg[/color]")
    oEmail.Close olSave
    'change the src property to 'cid:your picture filename'
    'it will be changed to the correct cid when its sent.
    oEmail.HTMLBody = "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
    "<IMG alt='' hspace=0 src='[color=red]cid:MyPic.jpg[/color]' align=baseline border=0>&nbsp;</BODY>"
    oEmail.Save
    oEmail.Display 'fill in the To, Subject, and Send. Or program it in.
    Set oEmail = Nothing
    Set colAttach = Nothing
    Set oAttach = Nothing
    Set oApp = Nothing

End Sub

您可以在以下位置找到它：

http://www.vbforums.com/showthread.php?278600-VB-Embedd-an-image-into-an-Outlook-email-message-body

【讨论】：

【解决方案3】：

这是 Dmitry Streblechenko (MVP) 编写的 vb 代码 sn-p。对我来说效果很好。

Set objOutlook = CreateObject("Outlook.Application")
Set Ns = objOutlook.GetNamespace("MAPI")
Ns.Logon
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
Set objOutlookRecip = objOutlookMsg.Recipients.Add("test@dimastr.com")
objOutlookRecip.Type = olTo
objOutlookMsg.Subject = "test"
' add graphic as attachment to Outlook message
Set colAttach = objOutlookMsg.Attachments
Set l_Attach = colAttach.Add("z:\Temp\8\1.jpg ")
l_Attach.PropertyAccessor.SetProperty "http:// schemas.microsoft.com/mapi/proptag/0x370E001F", "image/jpeg"  '
Change From 0x370eE001E
l_Attach.PropertyAccessor.SetProperty "http:// schemas.microsoft.com/mapi/proptag/0x3712001F", "myident"
'Changed from 0x3712001E
objOutlookMsg.PropertyAccessor.SetProperty "http:// schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8514000B", True
'
Set body format to HTML
objOutlookMsg.BodyFormat = olFormatHTML
objOutlookMsg.HTMLBody = "html tags goes here< img align="
baseline " order="
1 " hspace="
0 " src="
cid: myident " width="
" 600="
" > </img> end html tags"
objOutlookMsg.Save
objOutlookMsg.Send

【讨论】：

链接似乎不再起作用，“您要查找的资源已被删除、更改名称或暂时不可用。”反正我能拿到最新的吗？

【解决方案4】：

这是我发现的最适合我的方法。我以前只是链接到子文件夹，但发现一些国际用户经历了巨大的延迟，甚至在收件箱中崩溃了。我切换到下面，以便图像嵌入到电子邮件中，它解决了延迟问题，因为文件实际上嵌入到了电子邮件中。

Sub sendKeyMailer()


Dim emlMsg As Object
    Set emlMsg = CreateObject("CDO.Message")

    strBody = "<html> yadda yadda tricks are for kids. <br><br>"
    strBody = strBody & "<img src=""cid:myimage.jpg""><BR><BR>"
    strBody = strBody & "but tricks make the world go round.</html>"

    emlMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    emlMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "<<yourserver>>"
    emlMsg.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    emlMsg.Configuration.Fields.Update
    
    emlMsg.AddRelatedBodyPart "C:\temp\The Big Eskimo Roll.jpg", "myimage.jpg", cdoRefTypeId
    emlMsg.Fields.Item("urn:schemas:mailheader:Content-ID") = "<myimage.jpg>"
    emlMsg.Fields.Update
        
    
    With emlMsg
            .To = "allthepeople@yourcompany.com"
            .From = "aGrpLst@yourcompany.com"
            .Subject = "Humpty dumpty had a great fall"  '''I have kids....;^D.....
            .HTMLbody = strBody
            '.AddAttachment "C:\temp\The Big Eskimo Roll.jpg"
            .Send
    End With

    Set emlMsg = Nothing

End Sub

【讨论】：