我有Office 2003 VBA代码,它使用the technique described here使用未记录的MAPI属性和CDO 1.21在HTML消息中嵌入图像。
不再支持CDO 1.21,但according to MSDN,其大部分功能现已合并到Outlook 2010对象模型中。
在哪里可以找到使用Outlook 2010对象模型在Outlook 2010邮件中嵌入图像的示例?
答案 0 :(得分:2)
找到答案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
答案 1 :(得分: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> </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
答案 2 :(得分:1)
这是Dmitry Streblechenko(MVP)的vb代码片段。它对我来说很好。
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
答案 3 :(得分:0)
这是我发现最适合我的方法。我曾经只是链接到该子文件夹,但发现一些国际用户遇到了巨大的滞后,甚至使收件箱崩溃了。我切换到下面,因此图像被嵌入了电子邮件中,并且由于文件实际上已嵌入电子邮件中,因此解决了滞后问题。
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