K
Keith
Thanks to Sue (and everyone) for earlier suggestions- I still haven't
managed to get the following code working, probably because I still don't
understand everything that it does. Another procedure (in Excel) creates the
graphics to be embedded, and my goal is to bring those graphics (a variable
number of graphics per email) into the email, inline with some text.
desired end result:
(start email body)
image
text
image
text
etc.
I have two challenges:
1. When I use the code below without the loops, the first graphic is
imported inline and the rest are attached- my attempts to loop through each
attachment isn't working- with the code below, none of them are in-line, and
I get one little box with the red X in the the email
2. So far, I haven't figured out how to insert the HTML tags and some sample
text /in between/ the graphic images, inline in the email. I need to add a
few words between each image to give instructions. I can work out the text
itself, I'm just having trouble getting anything at all to add between
images
Any and all help would be greatly appreciated!!
Keith
Function EmbeddedHTMLGraphicDemo(SendToName As String, SendFileCount As
Integer)
' Outlook objects
Dim objApp As Outlook.Application
Dim l_Msg As MailItem
Dim colAttach As Outlook.Attachments
Dim l_Attach As Outlook.Attachment
Dim oSession As MAPI.Session
' CDO objects
Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments
Dim oAttach As MAPI.Attachment
Dim colFields As MAPI.Fields
Dim oField As MAPI.Field
Dim strEntryID As String
' create new Outlook MailItem
Set objApp = CreateObject("Outlook.Application")
Set l_Msg = objApp.CreateItem(olMailItem)
' add graphic as attachment to Outlook message
' change path to graphic as needed
Set colAttach = l_Msg.Attachments
FName = "c:\" & SendToName
FExt = ".gif"
For n = 1 To SendFileCount
'*** I've commented out the addition of the HTML BR tags, because it gave me
a
' runtime error, but this seems like the right place to add the text
to get it in
' between each image (?). Maybe it should be on it's own line, but
what syntax
' adds it to l_Attach after a set statement that adds an image? ***
Set l_Attach = colAttach.Add(FName & CStr(n) & FExt) '& "<br> </br>" &
"test text" & "<br> </br>"
Next
l_Msg.Close olSave
strEntryID = l_Msg.EntryID
Set l_Msg = Nothing
' POSITION CRITICAL must dereference the
' attachment objects before changing their properties
' via CDO
Set colAttach = Nothing
Set l_Attach = Nothing
' initialize CDO session
On Error Resume Next
Set oSession = CreateObject("MAPI.Session")
oSession.Logon "", "", False, False
' get the message created earlier
Set oMsg = oSession.GetMessage(strEntryID)
' set properties of the attached graphic that make
' it embedded and give it an ID for use in an <IMG> tag
Set oAttachs = oMsg.Attachments
'*** added a loop here, since there are multiple images attached ***
For n = 1 To SendFileCount
Set oAttach = oAttachs.Item(n)
Set colFields = oAttach.Fields
Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, "image/jpeg")
' *** added cstr(n) on the end of myindent to make each one unique ***
' *** I have no idea what &H3712001E refers to, or if I need to change it in
the loop, and if so, how ***
Set oField = colFields.Add(&H3712001E, "myident" & CStr(n))
'*** same with "{0820060000000000C000000000000046}0x8514" ***
oMsg.Fields.Add "{0820060000000000C000000000000046}0x8514", 11, True
oMsg.Update
Next
' get the Outlook MailItem again
Set l_Msg = objApp.GetNamespace("MAPI").GetItemFromID(strEntryID)
' add HTML content -- the <IMG> tag
l_Msg.HTMLBody = "<IMG align=baseline border=0 hspace=0 src=cid:myident>"
l_Msg.Close (olSave)
l_Msg.Display
' clean up objects
Set oField = Nothing
Set colFields = Nothing
Set oMsg = Nothing
oSession.Logoff
Set oSession = Nothing
Set objApp = Nothing
Set l_Msg = Nothing
End Function
managed to get the following code working, probably because I still don't
understand everything that it does. Another procedure (in Excel) creates the
graphics to be embedded, and my goal is to bring those graphics (a variable
number of graphics per email) into the email, inline with some text.
desired end result:
(start email body)
image
text
image
text
etc.
I have two challenges:
1. When I use the code below without the loops, the first graphic is
imported inline and the rest are attached- my attempts to loop through each
attachment isn't working- with the code below, none of them are in-line, and
I get one little box with the red X in the the email
2. So far, I haven't figured out how to insert the HTML tags and some sample
text /in between/ the graphic images, inline in the email. I need to add a
few words between each image to give instructions. I can work out the text
itself, I'm just having trouble getting anything at all to add between
images
Any and all help would be greatly appreciated!!
Keith
Function EmbeddedHTMLGraphicDemo(SendToName As String, SendFileCount As
Integer)
' Outlook objects
Dim objApp As Outlook.Application
Dim l_Msg As MailItem
Dim colAttach As Outlook.Attachments
Dim l_Attach As Outlook.Attachment
Dim oSession As MAPI.Session
' CDO objects
Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments
Dim oAttach As MAPI.Attachment
Dim colFields As MAPI.Fields
Dim oField As MAPI.Field
Dim strEntryID As String
' create new Outlook MailItem
Set objApp = CreateObject("Outlook.Application")
Set l_Msg = objApp.CreateItem(olMailItem)
' add graphic as attachment to Outlook message
' change path to graphic as needed
Set colAttach = l_Msg.Attachments
FName = "c:\" & SendToName
FExt = ".gif"
For n = 1 To SendFileCount
'*** I've commented out the addition of the HTML BR tags, because it gave me
a
' runtime error, but this seems like the right place to add the text
to get it in
' between each image (?). Maybe it should be on it's own line, but
what syntax
' adds it to l_Attach after a set statement that adds an image? ***
Set l_Attach = colAttach.Add(FName & CStr(n) & FExt) '& "<br> </br>" &
"test text" & "<br> </br>"
Next
l_Msg.Close olSave
strEntryID = l_Msg.EntryID
Set l_Msg = Nothing
' POSITION CRITICAL must dereference the
' attachment objects before changing their properties
' via CDO
Set colAttach = Nothing
Set l_Attach = Nothing
' initialize CDO session
On Error Resume Next
Set oSession = CreateObject("MAPI.Session")
oSession.Logon "", "", False, False
' get the message created earlier
Set oMsg = oSession.GetMessage(strEntryID)
' set properties of the attached graphic that make
' it embedded and give it an ID for use in an <IMG> tag
Set oAttachs = oMsg.Attachments
'*** added a loop here, since there are multiple images attached ***
For n = 1 To SendFileCount
Set oAttach = oAttachs.Item(n)
Set colFields = oAttach.Fields
Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, "image/jpeg")
' *** added cstr(n) on the end of myindent to make each one unique ***
' *** I have no idea what &H3712001E refers to, or if I need to change it in
the loop, and if so, how ***
Set oField = colFields.Add(&H3712001E, "myident" & CStr(n))
'*** same with "{0820060000000000C000000000000046}0x8514" ***
oMsg.Fields.Add "{0820060000000000C000000000000046}0x8514", 11, True
oMsg.Update
Next
' get the Outlook MailItem again
Set l_Msg = objApp.GetNamespace("MAPI").GetItemFromID(strEntryID)
' add HTML content -- the <IMG> tag
l_Msg.HTMLBody = "<IMG align=baseline border=0 hspace=0 src=cid:myident>"
l_Msg.Close (olSave)
l_Msg.Display
' clean up objects
Set oField = Nothing
Set colFields = Nothing
Set oMsg = Nothing
oSession.Logoff
Set oSession = Nothing
Set objApp = Nothing
Set l_Msg = Nothing
End Function