Reputation: 124686
I have Office 2003 VBA code that uses the technique described here to embed an image in an HTML message using undocumented MAPI properties and CDO 1.21.
CDO 1.21 is no longer supported, but according to MSDN, most of its functionality is now incorporated into the Outlook 2010 object model.
Where can I find a sample that embeds images in an Outlook 2010 message using the Outlook 2010 object model?
Upvotes: 2
Views: 23556
Reputation: 11
This is a vb code snippet by Dmitry Streblechenko (MVP). It worked fine for me.
Set objOutlook = CreateObject("Outlook.Application")
Set Ns = objOutlook.GetNamespace("MAPI")
Ns.Logon
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
Set objOutlookRecip = objOutlookMsg.Recipients.Add("[email protected]")
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
Upvotes: 1
Reputation: 126
Here is the method I've found works the best for me. I used to just link to the subfolder but found some international users experienced huge lag and even crashed there inbox. I switched to the below so that the image was imbedded in the email and it solved the lag issues because the file is actually embedded in the email.
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 = "[email protected]"
.From = "[email protected]"
.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
Upvotes: 0
Reputation: 21
Here other example:
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
you can find it on:
http://www.vbforums.com/showthread.php?278600-VB-Embedd-an-image-into-an-Outlook-email-message-body
Upvotes: 2
Reputation: 124686
Found the answer here.
The key bits being:
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
Upvotes: 2