Multipart MIME email

Hi,

I am modifying an existing sendmail function that we created to send newsletters to embed images in the email itself as previously users would have to click on "allow images" before they can view the email correctly.

I seem to have got this working (though there may be a better solution), however, I have noticed that the inline images are being displayed as attachments in Outlook 2007 and Entourage (Thunderbird works perfectly however).

I would like for the inline images to be hidden as they are in Thunderbird.

I don't know if what I am asking is possible, but I suspect that if it is, it has something to do with my MIME hierarchy.

Please see my attached code, I apologise for the mess, I have been trying multiple things and will clean it up once it is working correctly.

Thanks

Call sendMailMultipleInit(myrs1("Subject"))
Do While NOT myrs2.EOF
	'Loop through a contacts table sending an email to each contact
	Call sendMailMultiple(myrs2("ContactEmail"), EmailContentHTML, EmailContentPlain, myrs1("EmailImages"))
	myrs2.MoveNext
Loop
Call sendMailMultipleClose

Sub sendMailMultipleInit(TheSubJect)
	'Create the objects
	Set iMsg = CreateObject("CDO.Message")
	Set iConf = CreateObject("CDO.Configuration")
	Set Flds = iConf.Fields
	Set iMsgParts = iMsg.BodyPart
	Set iMsgPlain = iMsgParts.AddBodyPart
	Set iMsgHTML = iMsgParts.AddBodyPart

	'Set up the SMTP connection
	Flds("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	Flds("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.domain.com"
	Flds("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
	Flds("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	Flds("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
	If Request.QueryString("f") = "news" Then
		Flds("http://schemas.microsoft.com/cdo/configuration/sendusername") = "newsletter@domain.com"
		Flds("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxx"
	ElseIf Request.QueryString("f") = "offer" Then
		Flds("http://schemas.microsoft.com/cdo/configuration/sendusername") = "offers@domain.com"
		Flds("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxx"
	Else
		Flds("http://schemas.microsoft.com/cdo/configuration/sendusername") = Session("EmailUsername")
		Flds("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Session("EmailPassword")
	End If
	Flds("urn:schemas:mailheader:content-type") = "multipart/mixed"
	Flds.Update
	Set iMsg.Configuration = iConf
	
	'Set the content type of the message parts
	Set iMsgPartsFlds = iMsgParts.Fields
	iMsgPartsFlds("urn:schemas:mailheader:content-type") = "multipart/alternative"
	iMsgPartsFlds.Update
	Set iMsgPlainFlds = iMsgPlain.Fields
	iMsgPlainFlds("urn:schemas:mailheader:content-type") = "text/plain; charset=""utf-8"""
	iMsgPlainFlds("urn:schemas:mailheader:content-disposition") = "inline"
	iMsgPlainFlds.Update
	Set iMsgHTMLFlds = iMsgHTML.Fields
	iMsgHTMLFlds("urn:schemas:mailheader:content-type") = "text/html; charset=""utf-8"""
	iMsgHTMLFlds("urn:schemas:mailheader:content-disposition") = "inline"
	iMsgHTMLFlds.Update
	
	'Set common message data
	iMsg.From = """Company Name"" <" & Session("EmailUsername") & ">"
	iMsg.ReplyTo = Session("Email")
	If Request.QueryString("f") = "news" Then
		iMsg.From = """Company Name"" <newsletter@domain.com>"
		iMsg.ReplyTo = "newsletter@domain.com"
	ElseIf Request.QueryString("f") = "offer" Then
		iMsg.From = """Company Name"" <offers@domain.com>"
		iMsg.ReplyTo = "offers@domain.com"
	Else
		iMsg.From = """Company Name"" <" & Session("EmailUsername") & ">"
		iMsg.ReplyTo = Session("Email")
	End If
	iMsg.Subject  = TheSubJect
	AttachmentsSet = False
End Sub
Sub sendMailMultiple(ToAddress, HTMLContent, PlainContent, InlineAttachments)
	'Set unique message data
	iMsg.To = ToAddress

	'Add plain content to the plain stream
	Set iMsgStream = iMsgPlain.GetDecodedContentStream
	iMsgStream.WriteText PlainContent
	iMsgStream.Flush
	
	'Prepare attachments and attach to email
	If AttachmentsSet = False And InlineAttachments <> "" Then
		InlineAttachmentArray = Split(InlineAttachments, "|")
		AttachmentsSet = True
	End If
	If AttachmentsSet = True Then
		Dim iMsgImage, iMsgImageFlds
		For i = 0 To UBound(InlineAttachmentArray)
			AttachmentFilename = Right(InlineAttachmentArray(i), Len(InlineAttachmentArray(i)) - InStrRev(InlineAttachmentArray(i), "/"))
			AttachmentFileExtension = Right(AttachmentFilename, 3)
			If AttachmentFileExtension = "jpg" Then AttachmentFileExtension = "jpeg"
			Set iMsgImage = iMsg.AddRelatedBodyPart("G:\Websites\domain.www.com\www" & Replace(InlineAttachmentArray(i), "/", "\"), AttachmentFilename & "@inline_attachment", 0)
			Set iMsgImageFlds = iMsgImage.Fields
			iMsgImageFlds("urn:schemas:mailheader:content-type") = "image/" & AttachmentFileExtension
			iMsgImageFlds("urn:schemas:mailheader:content-disposition") = "image/" & AttachmentFileExtension
			iMsgImageFlds.Update
			Set iMsgImageFlds = Nothing
			Set iMsgImage = Nothing
			HTMLContent = Replace(HTMLContent, "http://www.domain.com" & InlineAttachmentArray(i), "cid:" & AttachmentFilename & "@inline_attachment")
		Next
	End If

	'Add HTML content to the HTML stream
	Set iMsgStream = iMsgHTML.GetDecodedContentStream
	iMsgStream.WriteText HTMLContent
	iMsgStream.Flush

	'Send the message
	LastEmailSuccess = True
	On Error Resume Next
		iMsg.Send
		If Err.Number <> 0 Then
			Response.Write iMsg.To & ":Failed<br />"
			LastEmailSuccess = False
			Err.Clear
		End If
	On Error Goto 0
End Sub
Sub sendMailMultipleClose()
	On Error Resume Next
		For Each Item In iMsg.Fields
			Response.Write Item & "<br />"
		Next
	On Error Goto 0
	'Release the ojects
	Set iMsgStream = Nothing
	Set iMsgPlainFlds = Nothing
	Set iMsgHTMLFlds = Nothing
	Set iMsgPartsFlds = Nothing
	Set Flds = Nothing
	Set iConf = Nothing
	Set iMsgPlain = Nothing
	Set iMsgHTML = Nothing
	Set iMsgParts = Nothing
	Set iMsg = Nothing
End Sub

Select allOpen in new window