Eingebundene Bilder in Outlook-HTML-Mail / embedded graphics in HTML

[Stefan Wirrer]

Hallo,

hier mal eine vollständige Lösung zum Versenden einer HTML-Mail
mit eingebundenen Bildern aus Outlook 2000.
Die Lösungsansätze sind aus verschiedenen NG's.
Es ist kein CDO-Verweis notwendig!
VBA-Code in MS-Access 2000

Here a complete solution for sending a HTML mail with embedded
graphics via Outlook 2000.
The methods of solution are from different NG's.
You don't need the CDO reference!
VBA-Code with MS-Access 2000

'--- Start of Code ---
Public Function sendOLEmbeddedHTMLGraphic(strSendTo As String, _
Optional strSendCC As Variant, _
Optional strSendBCC As Variant, _
Optional strSubject As Variant, _
Optional strBody As Variant, _
Optional varAttachement As
Variant)
'===========================================================================
=
' Versenden einer HTML-Mail mit mehreren eingebetteten
' Bildern via Outlook.
'
' Zur Info:
' Das Versenden funktioniert nicht mit Base64-eingebundenen
' IMG, da das der IE (und damit OL) nicht unterstützt.
' http://aktuell.de.selfhtml.org/artikel/grafik/inline-images/index.htm
'
' Daher folgende Lösung als Ausgangsbasis:
' To add an embedded image to an HTML message
' This technique by Outlook MVP Neo uses undocumented MAPI
' properties and CDO to add an embedded image file
' to a message and set the CID so th at an HTMLBody
' property <img> tag can set that image as the sourc.
' In VBA or Visual Basic, you will need to add a reference
' to the CDO 1.21 library to use this procedure.
' http://www.outlookcode.com/d/code/htmlimg.htm
'
' varAttachement: Die Bilder werden als Anhang in einem Array
' übergeben
' strBody: Enhält den HTML-Code incl. aller <IMG>-Tags incl.
' src=cid:xyz
' cid in strBody und hier im Code müssen zusammenpassen
' Ein Verweis auf die CDO 1.21 Library ist wg. Latebinding nicht notwendig!
'
' Codeanleihen auch von Henry Habermacher aus der NG
' microsoft.public.de.access
' vom 29. Jan. 2004 zum Thema OL-Mail (Function sendOLMail).
'
' Stefan Wirrer, Volke Consulting Engineers GmbH, München, Deutschland
' Erstellt am 10.08.2006, Stand: 10.08.2006

Dim olApp As Object
Dim olItem As Object
Dim CDOSession As Object
Dim CDOMessage As Object
Dim CDOFields As Object
Dim CDOField As Object
Dim strEntryID As String
Dim strCID As String
Dim strAttach As String
Dim lngI As Long
Dim intPos1 As Integer
Dim intPos2 As Integer

Const olMailItem As Integer = 0
Const olSave As Integer = 0
Const CdoPR_ATTACH_MIME_TAG = 923664414

'-- create new Outlook MailItem
Set olApp = CreateObject("Outlook.Application")
Set olItem = olApp.CreateItem(olMailItem)

olItem.To = Nz(strSendTo, "")
olItem.CC = Nz(strSendCC, "")
olItem.bcc = Nz(strSendBCC, "")
olItem.Subject = Nz(strSubject, "")

For lngI = LBound(varAttachement) To UBound(varAttachement)
If Len(varAttachement(lngI)) > 0 Then
'-- add graphic as attachment to Outlook message, change path to
graphic as needed
strAttach = CStr(varAttachement(lngI))
olItem.Attachments.Add strAttach

olItem.Close olSave
strEntryID = olItem.EntryID
Set olItem = Nothing

'-- initialize CDO session
Set CDOSession = CreateObject("MAPI.Session")
CDOSession.Logon "", "", False, False

'-- get the message created earlier
Set CDOMessage = CDOSession.GetMessage(strEntryID)

'-- CID-Name = "myident" + Dateiname des Anhangs ohne Endung
intPos1 = InStrRev(Replace(strAttach, "/", "\"), "\") + 1
intPos2 = InStrRev(strAttach, ".") - 1
strCID = Mid(strAttach, intPos1, Len(strAttach) - intPos2)
strCID = "myident" & strCID

'-- set properties of the attached graphic that make
' it embedded and give it an ID for use in an <IMG> tag
Set CDOFields = CDOMessage.Attachments.Item(lngI).Fields
Set CDOField = CDOFields.Add(CdoPR_ATTACH_MIME_TAG, "image/jpeg")
Set CDOField = CDOFields.Add(&H3712001E, strCID)
CDOMessage.Fields.Add "{0820060000000000C000000000000046}0x8514",
11, True
CDOMessage.Update

'-- get the Outlook MailItem again
Set olItem = olApp.GetNamespace("MAPI").GetItemFromID(strEntryID)
olItem.Close (olSave)
End If
Next

'-- add HTML content -- the <IMG> tag
'olItem.HTMLBody = "<IMG align=baseline border=0 hspace=0
src=cid:myident>"
olItem.HTMLBody = strBody

'-- display the mail
olItem.Display

'olItem.Send

'-- clean up objects
Set CDOField = Nothing
Set CDOFields = Nothing
Set CDOMessage = Nothing
CDOSession.Logoff
Set CDOSession = Nothing
Set olApp = Nothing
Set olItem = Nothing

End Function
'--- End of Code ---


--
Gruß
aus München

Stefan

(e-mail address removed)
---------------------------------------------------------------------
KnowHow-MDB: http://www.freeaccess.de/
Access-FAQ: http://www.donkarl.com/AccessFAQ.htm
Infos für Neulinge in den Access-Newsgroups:
http://www.doerbandt.de/access/Newbie.htm
Stammtisch: http://www.access-muenchen.de/