Email Image Embedding Failure
I have an email function that needs to embed images into the email. I get the mail
into my pickup but the mail still asks me to "Show Images/Download Images". Some how
the images are not being properly embedded. I'm not sure what needs to be changed the examples I find on a lot of sites is very basic and vague. I appreciate any assistance. Thank You
Additional info for clarity: This function will either download the images via url or embed them. This is determined
via an external xml parameter. The physical path for the images, which replaces the URLs, is also in the xml.
Code:
Private Function SendEMail(ByVal fromemail As String, ByVal toemail As String, ByVal format As String, ByVal subject As String, ByVal message As String, ByVal promoMail As Boolean) As String
Try
Dim eResult As String
Dim plainView As AlternateView
Dim htmlView As AlternateView
Dim i As Integer
toemail = Replace(toemail, ";", ",")
If Len(message) > 0 Then
'create the mail message
Using mail As New MailMessage
'set the addresses
mail.From = New MailAddress("[email protected]")
mail.ReplyToList.Add(fromemail)
mail.To.Add(toemail)
'set the content
mail.Subject = subject
If LCase(format) <> "text" Then
Dim HTMLBody As String
Dim style As String = ""
Dim SSIndex As Integer
Dim SEIndex As Integer
'Split the message body and the CSS
SSIndex = InStr(1, LCase(message), "<style")
SEIndex = InStr(1, LCase(message), "</style>")
If SSIndex > 0 And SEIndex > SSIndex Then
style = Mid(message, SSIndex, SEIndex - SSIndex + 8)
message = Mid(message, SEIndex + 8)
End If
'Build email
HTMLBody = "<!DOCTYPE HTML PUBLIC """"-//W3C//DTD HTML 4.0 Transitional//EN"""">" & vbCrLf & _
"<html>" & vbCrLf & _
"<head>" & vbCrLf & _
"<META http-equiv=Content-Type content=""""text/html; charset=us-ascii"""">" & vbCrLf & _
"<title>" & subject & "</title>" & vbCrLf & _
style & "</head>" & vbCrLf & _
"<body style=""color: navy;"">" & vbCrLf & _
message & "<br>" & vbCrLf & _
"</body>" & vbCrLf & _
"</html>" & vbCrLf
If embed = True And promoMail = True Then
mail.IsBodyHtml = True
mail.BodyEncoding = System.Text.Encoding.ASCII
mail.Body = HTMLBody
Dim domainValue = From c In connections.<Connect> Select c.<domain>.Value
Dim pathValue = From c In connections.<Connect> Select c.<drivePath>.Value
'Embed, if any, images into the email
Dim reg As New Regex("src[^>]*[^/].(?:jpg|png|gif)(?:""|')")
'Dim messageOut As MailMessage = message
Dim msgString As String
msgString = mail.Body.ToString()
'This block will check if anything in the message body
'is an image.
Dim match As Match
htmlView = AlternateView.CreateAlternateViewFromString(msgString, Nothing, "text/html")
plainView = AlternateView.CreateAlternateViewFromString(msgString, Nothing, "text/plain")
For Each match In reg.Matches(mail.Body)
Dim cid As String = Guid.NewGuid().ToString("N")
Dim src As String = match.Value
src = src.Replace("src=", "")
src = src.Replace("""", "")
Dim tempSrc = src
'Check if image to be attached is on a website
If src.StartsWith(domainValue.ElementAt(0).ToString()) Then
'Example parameters: src = src.Replace("http://eating-out/", "Z:\Websites\eating\")
src = src.Replace(domainValue.ElementAt(0).ToString(), pathValue.ElementAt(0).ToString())
src = src.Replace("/", "\")
msgString = msgString.Replace(tempSrc, src)
End If
Dim imagelink As New LinkedResource(src)
imagelink.ContentId = cid
imagelink.TransferEncoding = System.Net.Mime.TransferEncoding.Base64
htmlView.LinkedResources.Add(imagelink)
msgString = msgString.Replace(src, "cid:" + cid)
mail.Body = msgString
Next match
'Set up plain text and html mail formats
mail.Priority = MailPriority.High
mail.AlternateViews.Add(htmlView)
mail.AlternateViews.Add(plainView)
Else
'Set up plain text and html mail formats
mail.Priority = MailPriority.High
plainView = AlternateView.CreateAlternateViewFromString(message, Nothing, "text/plain")
plainView.TransferEncoding = TransferEncoding.Base64
htmlView = AlternateView.CreateAlternateViewFromString(HTMLBody, Nothing, "text/html")
htmlView.TransferEncoding = TransferEncoding.Base64
mail.AlternateViews.Add(plainView)
mail.AlternateViews.Add(htmlView)
End If
Else
mail.IsBodyHtml = False
mail.Body = message
End If
'if we are using the IIS SMTP Service, we can write the message
'directly to the PickupDirectory, and bypass the Network layer
Dim smtp As New SmtpClient()
smtp.PickupDirectoryLocation = "C:\inetpub\mailroot\Pickup"
smtp.DeliveryMethod = SmtpDeliveryMethod.SpecifiedPickupDirectory
'smtp.DeliveryMethod = SmtpDeliveryMethod.PickupDirectoryFromIis
smtp.Send(mail)
eResult = "Successful"
smtp = Nothing
Return eResult
End Using
Else
eResult = "Nothing to send"
Return eResult
End If
Catch ex As Exception
Return "Error"
End Try
End Function
Re: Email Image Embedding Failure
Solved it :-)
Code:
Private Function SendEMail(ByVal fromemail As String, ByVal toemail As String, ByVal format As String, ByVal subject As String, ByVal message As String, ByVal promoMail As Boolean) As String
Try
Dim eResult As String
Dim plainView As AlternateView
Dim htmlView As AlternateView
Dim i As Integer = 0
toemail = Replace(toemail, ";", ",")
If Len(message) > 0 Then
'create the mail message
Using mail As New MailMessage
'set the addresses
mail.From = New MailAddress("[email protected]")
mail.ReplyToList.Add(fromemail)
mail.To.Add(toemail)
'set the content
mail.Subject = subject
If LCase(format) <> "text" Then
Dim HTMLBody As String
Dim style As String = ""
Dim SSIndex As Integer
Dim SEIndex As Integer
'Split the message body and the CSS
SSIndex = InStr(1, LCase(message), "<style")
SEIndex = InStr(1, LCase(message), "</style>")
If SSIndex > 0 And SEIndex > SSIndex Then
style = Mid(message, SSIndex, SEIndex - SSIndex + 8)
message = Mid(message, SEIndex + 8)
End If
'Build email
HTMLBody = "<!DOCTYPE HTML PUBLIC """"-//W3C//DTD HTML 4.0 Transitional//EN"""">" & vbCrLf & _
"<html>" & vbCrLf & _
"<head>" & vbCrLf & _
"<META http-equiv=Content-Type content=""""text/html; charset=us-ascii"""">" & vbCrLf & _
"<title>" & subject & "</title>" & vbCrLf & _
style & "</head>" & vbCrLf & _
"<body style=""color: navy;"">" & vbCrLf & _
message & "<br>" & vbCrLf & _
"</body>" & vbCrLf & _
"</html>" & vbCrLf
If embed = True And promoMail = True Then
mail.IsBodyHtml = True
mail.BodyEncoding = System.Text.Encoding.ASCII
mail.Body = HTMLBody
Dim imageReplaceArray(0) As String
'Retrieve the domain to be replaced and the physical disk path it wil be replaced with
Dim domainValue = From c In connections.<Connect> Select c.<domain>.Value
Dim pathValue = From c In connections.<Connect> Select c.<drivePath>.Value
Dim reg As New Regex("src[^>]*[^/].(?:jpg|png|gif)(?:""|')")
Dim msgString As String
msgString = mail.Body.ToString()
Dim match As Match
For Each match In reg.Matches(msgString)
Dim cid As String = Guid.NewGuid().ToString("N")
Dim src As String = match.Value
src = src.Replace("src=", "")
src = src.Replace("""", "")
Dim tempSrc = src
'Replace all URL paths with hard disk paths
If src.StartsWith(domainValue.ElementAt(0).ToString()) Then
src = src.Replace(domainValue.ElementAt(0).ToString(), pathValue.ElementAt(0).ToString())
src = src.Replace("/", "\")
msgString = msgString.Replace(tempSrc, src)
End If
If imageReplaceArray.Length > 0 Then
ReDim Preserve imageReplaceArray(i)
End If
imageReplaceArray(i) = src + "," + cid
'Insert cid values into src value for each image
Dim temp() As String = imageReplaceArray(i).Split(CChar(","))
msgString = msgString.Replace(temp(0).ToString, "cid:" + temp(1).ToString())
i = i + 1
Next
'Create alternate views
htmlView = AlternateView.CreateAlternateViewFromString(msgString, Nothing, "text/html")
plainView = AlternateView.CreateAlternateViewFromString(msgString, Nothing, MediaTypeNames.Text.Plain)
'Pair link resource with contentID
For i = 0 To imageReplaceArray.Length - 1
Dim temp() As String = imageReplaceArray(i).Split(CChar(","))
Dim imagelink As New LinkedResource(temp(0).ToString)
imagelink.ContentId = temp(1).ToString
imagelink.TransferEncoding = System.Net.Mime.TransferEncoding.Base64
htmlView.LinkedResources.Add(imagelink)
Next
'Set up plain text and html mail formats
mail.Priority = MailPriority.High
plainView.TransferEncoding = TransferEncoding.Base64
htmlView.TransferEncoding = TransferEncoding.Base64
mail.AlternateViews.Add(htmlView)
mail.AlternateViews.Add(plainView)
Else
'Set up plain text and html mail formats
mail.Priority = MailPriority.High
plainView = AlternateView.CreateAlternateViewFromString(message, Nothing, "text/plain")
plainView.TransferEncoding = TransferEncoding.Base64
htmlView = AlternateView.CreateAlternateViewFromString(HTMLBody, Nothing, "text/html")
htmlView.TransferEncoding = TransferEncoding.Base64
mail.AlternateViews.Add(plainView)
mail.AlternateViews.Add(htmlView)
End If
Else
mail.IsBodyHtml = False
mail.Body = message
End If
'if we are using the IIS SMTP Service, we can write the message
'directly to the PickupDirectory, and bypass the Network layer
Dim smtp As New SmtpClient()
smtp.PickupDirectoryLocation = "C:\inetpub\mailroot\Pickup"
smtp.DeliveryMethod = SmtpDeliveryMethod.SpecifiedPickupDirectory
'smtp.DeliveryMethod = SmtpDeliveryMethod.PickupDirectoryFromIis
smtp.Send(mail)
eResult = "Successful"
smtp = Nothing
Return eResult
End Using
Else
eResult = "Nothing to send"
Return eResult
End If
Catch ex As Exception
Return "Error"
End Try
End Function
Re: Email Image Embedding Failure
Welcome to VBForums :wave:
Thanks for sharing the solution, I'm sure some people will find it useful.
As you now have it sorted out, could you please do us a little favour, and mark the thread as Resolved?
(this saves time reading for those of us who like to answer questions, and also helps those who search to find answers)
You can do it by clicking on "Thread tools" just above the first post in this thread, then "Mark thread resolved". (like various other features of this site, you need JavaScript enabled in your browser for this to work).
