Problem Sending embedded image via outlook 2003 from Excel 2003 vba

Joined
May 23, 2007
Messages
2
Reaction score
0
Hi Guys,

I have the routine below set up to take a worksheet, and use the worksheet as the body of an email. The email needs to include a header image in the body, the routine below works perfectly in excel / outlook 2000, but in 2003 the email has the image attached but the body just shows the IE missing image indicator.

Can anyone tell me whats wrong?

Code:
Public Function SheetToHTML(sh As Worksheet)

	Dim TempFile As String
	Dim Nwb As Workbook
	Dim fso As Object
	Dim ts As Object

	sh.Copy
	Set Nwb = ActiveWorkbook

	With Nwb.Sheets(1)
		On Error Resume Next
		.DrawingObjects.Visible = True
		.DrawingObjects.Delete
		On Error GoTo 0
	End With

	TempFile = Environ$("temp") & "/" & _
			   Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

	Nwb.SaveAs TempFile, xlHtml
	Nwb.Close False

	Set fso = CreateObject("Scripting.FileSystemObject")
	Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
	SheetToHTML = ts.ReadAll
	ts.Close


	Set ts = Nothing
	Set fso = Nothing
	Set Nwb = Nothing
	Kill TempFile
End Function
Public Sub EMail()
  
' Outlook objects
   Dim OutApp As Outlook.Application
	Dim OutMail As Outlook.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 done, current, temp, addresses
  
  Dim strEntryID As String
	  
  ' Delete excess Rows
   Rows("1:3").Select
	Selection.Delete Shift:=xlUp
  
   ' create new Outlook MailItem
  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(olMailItem)

  ' add graphic as attachment to Outlook message
  ' change path to graphic as needed
  Set colAttach = OutMail.Attachments
  Set l_Attach = colAttach.Add("\\Other\OP-GDC.gif")
  OutMail.Close olSave
  strEntryID = OutMail.EntryID
  Set OutMail = Nothing
  ' *** POSITION CRITICAL *** you 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
  Set oAttach = oAttachs.Item(1)
  Set colFields = oAttach.Fields
  Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, "image/gif")
  Set oField = colFields.Add(&H3712001E, "myident")
  oMsg.Fields.Add "{0820060000000000C000000000000046}0x8514", 11, True
  oMsg.Update
  
 
		
	current = 1
	done = False
	temp = ""
	addresses = ""
	Do
		temp = Worksheets(2).Range("a" & current).Value
		If (temp = "") Then
		done = True
		Else: addresses = addresses & ";" & temp
		End If
		current = current + 1
	Loop Until done = True
	
	 ' get the Outlook MailItem again
  Set OutMail = OutApp.GetNamespace("MAPI").GetItemFromID(strEntryID)
	
  ' add HTML content -- the <IMG> tag
	With OutMail
		.To = addresses
		.CC = ""
		.BCC = ""
		.Subject = "Genesys Telephony Communication - " & Date
		.HTMLBody = "<IMG align=baseline border=0 hspace=0 src=cid:myident>" & SheetToHTML(Sheets("Report"))
		.Send   'or use .Display
	End With
	Application.ScreenUpdating = True
	
	  
  ' clean up objects
  Set oField = Nothing
  Set colFields = Nothing
  Set oMsg = Nothing
  oSession.Logoff
  Set oSession = Nothing
  Set OutMail = Nothing
	Set OutApp = Nothing
	
	'Close workbook without saving
	Application.DisplayAlerts = False
 Application.Quit

End Sub

Any help would be fantastic thanks.

SY
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top