visitor (0 QPoints)
  • FR
  • EN
  • NL
  • DE
  • ES
262 experts, 1140 registered users, 1616 questions already answered
European Experts Exchange, the very best site for high-quality IT solutions

We now celebrate our 5 years of existence and break our frequentation records... Here are the stats of those 5 years.

Languages :: Visual Basic :: Visual Basic 6 With MIME FORMAT Html Mail and embedded image


By: JacquesVdm Other  Date: 05/06/2008 14:27:09  English French  Points: 20 Status: Answered
Quality : Excellent
Hi can anyone please help me???!!??
I am using the winsock control to sent mail messages to recepiants.
Currently it is working fine.I use base64 encoding for images and i receive them as attachments.What I am struggling with is to also send the image not only as an attachment but also an embedded image. (img src = "cid:.......)

This code pasted below sent my html mail with the image as an attatchment with no problem.I just need to embed the image so that when the mail is opened the user will see the image on the page

Dim Se_Body As String
Dim Se_Type_Content As String
Dim Se_Type_Message As String
Dim Se_Type_Attach As String
Dim Se_Priority As String
Dim Se_Email_From As String
Dim Se_Email_To As String
Dim Se_Subject As String
Dim Se_Message_Text As String
Dim Se_Attach As String
Dim Se_Sender_Name As String
Dim Se_Sender_Ip As String
Dim Se_Next_to As String
Dim Se_Warn As String
Dim Npos As Integer

Const Boundary = "simpleboundary"

On Error GoTo errHandlerSendMail


If MailAccount = Empty Then
MsgBox "No sender mail address supplied,unable to send mail", vbCritical, "No sender mail address"
Exit Sub
End If


Se_Sender_Ip = Wnsck.LocalIP
If Se_Sender_Ip = "" Then Se_Sender_Ip = "x.x.x.x"

Se_Priority = MailPriority
Se_Sender_Name = "VISITOR MATE"
Se_Email_From = Trim$(MailAccount)
Se_Email_To = Trim$(Mail_Recipient)
Se_Subject = Trim$(Mail_Subject & Space(1) & "- Visitor : " & Vis_Initials & Space(1) & Vis_Surname)
Se_Attach = Trim$(Mail_AttachPath)


'Se_Warn = vbCrLf _
& "-------------------------------------------------------------------------------------------------" & vbCrLf _
& " This is an automated message from the visitor system." & vbCrLf _
& " Please do not replay to this message." & vbCrLf _
& " This message is purely intended for information perposes" & vbCrLf _
& " Thank you." & vbCrLf _
& "-------------------------------------------------------------------------------------------------"

Se_Type_Message = "This is a multi-part message in MIME format." & vbCrLf & vbCrLf _
& "--" & Boundary & vbCrLf _
& "Content-Type: text/html;" & " charset=" & """" & "iso-8859-1" & """" & vbCrLf _
& "Content-Transfer-Encoding: 7bit"

' Se_Message_Text = Trim$(Mail_Message) & vbCrLf & vbCrLf & vbCrLf & vbCrLf & Se_Warn

Se_Message_Text = "<!DOCTYPE HTML PUBLIC """ & "-//W3C//DTD HTML 4.0 Transitional//EN" & """>" & vbCrLf _
& "<HTML><HEAD><TITLE></TITLE> " & vbCrLf _
& "<META http-equiv=Content-Type content=""" & "text/html; charset=iso-8859-1" & """> " & vbCrLf _
& "<META content=""" & "MSHTML 6.00.2900.3314""" & " name=GENERATOR></HEAD>" & vbCrLf _
& "<BODY>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=4>INITIAL : " & Vis_Initials & "</FONT> </FONT></P>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=4>SURNAME : " & Vis_Surname & "</FONT> </FONT></P>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=4>COMPANY : " & Vis_Company & "</FONT> </FONT></P>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=4>PHONE NUMBER : " & Vis_PhoneNumber & "</FONT> </FONT></P>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=4>STATUS : " & Vis_Status & "</FONT> </FONT></P>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=4>DATE : " & Vis_Date & "</FONT> </FONT></P>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=4>TIME : " & Vis_Time & "</FONT> </FONT></P>" & vbCrLf _
& "<DIV><IMG alt=""" & "VISITOR IMAGE""" & " hspace=0 src=""" & Mail_AttachPath & """ align=baseline border=2></DIV></BODY></HTML>"


'attachment

If Len(Se_Attach) > 0 Then
Se_Type_Attach = "--" & Boundary & vbCrLf _
& "Content-Type: application/octet-stream;" & " name=" & """" & GetAttFileName(Se_Attach) & """" & vbCrLf _
& "Content-Transfer-Encoding: base64" & vbCrLf _
& "Content-Disposition: attachment;" & " filename=" & """" & GetAttFileName(Se_Attach) & """" & vbCrLf _
& vbCrLf _
& strEncodedAtt
End If

Se_Body = "X-Originating-IP: [" & Se_Sender_Ip & "]" & vbCrLf _
& "X-Originating-Email: [" & Se_Email_From & " ]" & vbCrLf _
& "X-Sender: " & Se_Email_From & vbCrLf _
& "X-Priority: " & Se_Priority & vbCrLf _
& "From: " & """" & Se_Sender_Name & """" & " <" & Se_Email_From & ">" & vbCrLf _
& "To: " & Se_Email_To & vbCrLf _
& "Subject: " & Se_Subject & vbCrLf _
& "Date: " & GetDateFormat & vbCrLf _
& "MIME-Version: 1.0" & vbCrLf _
& "Content-Type: multipart/mixed;" & " boundary =" & """" & Boundary & """" & vbCrLf _
& vbCrLf _
& Se_Type_Message & vbCrLf _
& vbCrLf _
& Se_Message_Text & vbCrLf _
& vbCrLf _
& Se_Type_Attach & vbCrLf _
& "." & vbCrLf

'==SEND HALLO (MAX TIMEOUT 30 SECONDS)===
frmMain.Wnsck.SendData "HELO " & Left(Se_Email_From, InStr(1, Se_Email_From, "@") - 1) & vbCrLf
If GetServerResponse("250", 30) = False Then GoTo errHandlerSendMail

'===SEND FROM===
frmMain.Wnsck.SendData "MAIL FROM: " & Se_Email_From & vbCrLf
If GetServerResponse("250", 20) = False Then GoTo errHandlerSendMail

'==SEND TO ALL ===
Do While InStr(1, Se_Email_To, ";") <> 0
Npos = InStr(1, Se_Email_To, ";")
Se_Next_to = Trim(Left(Se_Email_To, Npos - 1))
Se_Email_To = Trim(Mid(Se_Email_To, Npos + 1))
If Se_Next_to <> "" Then
frmMain.Wnsck.SendData "RCPT TO: " & Se_Next_to & vbCrLf
If GetServerResponse("250", 20) = False Then GoTo errHandlerSendMail
End If
Loop

If Se_Email_To <> "" Then frmMain.Wnsck.SendData "RCPT TO: " & Se_Email_To & vbCrLf
If GetServerResponse("250", 20) = False Then GoTo errHandlerSendMail

'===SEND DATA REQUEST===
frmMain.Wnsck.SendData "DATA" & vbCrLf
If GetServerResponse("354", 20) = False Then GoTo errHandlerSendMail

'===SEND THE DATA (MAX TOME OUT = 600ms)===
frmMain.Wnsck.SendData Se_Body
If GetServerResponse("250", 600) = False Then GoTo errHandlerSendMail

'===SEND QUIT===
frmMain.Wnsck.SendData "QUIT" & vbCrLf
If GetServerResponse("221", 20) = False Then GoTo errHandlerSendMail

'===CLOSE===
Lbl_Smtp_Status.Caption = "Message sent."
frmMain.Wnsck.Close
DoEvents
Exit Sub

errHandlerSendMail:

If BlnTimeOut = False Then
MsgBox "Failed sending the file:" & vbCrLf & vbCrLf & Err.Description, vbCritical
Else
MsgBox "Failed sending the file: Timeout Error.", vbCritical
End If
Err.Clear
frmMain.Wnsck.Close


thanks
Jacques
By: VGR Date: 05/06/2008 18:48:58 French English  Type : Comment
Salut Jacques,

If I'm not mistaken, if you intend to use img src="cid:img1" syntax, then your shoudl include your images, same encoding and such HTTP/MIME headers as before, but with the inline disposition : inline; filename=\"file1.jpg\";\r\nContent-ID: img1


warning : the images that will not display are only those used as background images. (browsers' security settings)
By: VGR Date: 12/09/2008 10:33:26 English  Type : Comment
ok ? if the comment was somewhat help, you may Close the Question ; if not you may provide more feedback ; you may also ask for a "close & refund" ;-)
By: JacquesVdm Date: 12/09/2008 12:28:00 English  Type : Comment
Hi VGR
Sorry I did not get back to you!
I sorted my broblem and everything is working!

Thanks for the help!

Like they say in Afrikaans!

Hy loop nou glad!

Thanks agian...this matter can be closed
By: VGR Date: 13/09/2008 10:36:00 English  Type : Answer
glad to read that, but can you post here the solution ? and close the question by (accordingly to the help) choosing the "A" or "S" button on the right ? Thanks
By: JacquesVdm Date: 15/09/2008 10:10:52 English  Type : Comment
Here is my solution

Dim Se_Body As String
Dim Se_Type_Content As String
Dim Se_Type_Message As String
Dim Se_Type_Attach As String
Dim Se_Priority As String
Dim Se_Email_From As String
Dim Se_Email_To As String
Dim Se_Subject As String
Dim Se_Message_Text As String
Dim Se_Attach As String
Dim Se_Sender_Name As String
Dim Se_Sender_Ip As String
Dim Se_Next_to As String
Dim Se_Warn As String
Dim Npos As Integer

Const Boundary = "simpleboundary"

On Error GoTo errHandlerSendMail


If MailAccount = Empty Then
MsgBox "No Sender Mail Address Supplied,Unable To Send Mail", vbCritical, "No Sender Mail Address"
Exit Sub
End If


Se_Sender_Ip = FrmMain.Wnsck.LocalIP
If Se_Sender_Ip = "" Then Se_Sender_Ip = "x.x.x.x"

Se_Priority = MailPriority
Se_Sender_Name = "VISITOR MATE"
Se_Email_From = Trim$(MailAccount)

If UCase(Optional_Mail_Address) = "NONE" And UCase(Mail_Recipient) = "NOT PRESENT" Then
MsgBox "Mail Address To Send To.Please Remove The Mailing Option From The Setup File Or Supply A Mail Address", vbInformation, "No Mail Address"
Exit Sub
End If

If UCase(Optional_Mail_Address) <> "NONE" And UCase(Mail_Recipient) <> "NOT PRESENT" Then
Se_Email_To = Trim$(Mail_Recipient) & ";" & Trim$(Optional_Mail_Address)
End If

If UCase(Optional_Mail_Address) = "NONE" And UCase(Mail_Recipient) <> "NOT PRESENT" Then
Se_Email_To = Trim$(Mail_Recipient)
End If

If UCase(Optional_Mail_Address) <> "NONE" And UCase(Mail_Recipient) = "NOT PRESENT" Then
Se_Email_To = Trim$(Optional_Mail_Address)
End If

Se_Subject = Trim$(Mail_Subject & Space(1) & "- Visitor : " & Vis_Initials & Space(1) & Vis_Surname)
Se_Attach = Trim$(Mail_AttachPath)

Se_Type_Message = "This is a multi-part message in MIME format." & vbCrLf & vbCrLf _
& "--" & Boundary & vbCrLf _
& "Content-Type: text/html;" & " charset=" & """" & "iso-8859-1" & """" & vbCrLf _
& "Content-Transfer-Encoding: 7bit"

If Len(Se_Attach) > 0 Then
Se_Type_Attach = "--" & Boundary & vbCrLf _
& "Content-Type: image/jpeg;" & " name=" & """" & GetAttFileName(Se_Attach) & """" & vbCrLf _
& "Content-Transfer-Encoding: base64" & vbCrLf _
& "Content-Disposition: inline; " & " filename=""" & GetAttFileName(Se_Attach) & """" & vbCrLf _
& "Content-ID: " & "<" & GetAttFileName(Se_Attach) & ">" & vbCrLf _
& vbCrLf _
& strEncodedAtt
End If

Se_Message_Text = "<!DOCTYPE HTML PUBLIC """ & "-//W3C//DTD HTML 4.0 Transitional//EN" & """>" & vbCrLf _
& "<HTML><HEAD><TITLE></TITLE> " & vbCrLf _
& "<META http-equiv=Content-Type content=""" & "text/html; charset=iso-8859-1" & """> " & vbCrLf _
& "<META content=""" & "MSHTML 6.00.2900.3314""" & " name=GENERATOR></HEAD>" & vbCrLf _
& "<BODY>" & vbCrLf _
& "<FONT color=#0000ff><FONT size=3>INITIAL : " & Vis_Initials & "</FONT> </FONT>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=3>SURNAME : " & Vis_Surname & "</FONT> </FONT></P>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=3>COMPANY : " & Vis_Company & "</FONT> </FONT></P>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=3>PHONE NUMBER : " & Vis_PhoneNumber & "</FONT> </FONT></P>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=3>STATUS : " & Vis_Status & "</FONT> </FONT></P>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=3>DATE : " & Vis_Date & "</FONT> </FONT></P>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=3>TIME : " & Vis_Time & "</FONT> </FONT></P>" & vbCrLf _
& "<img src=""cid:" & GetAttFileName(Se_Attach) & """ align=baseline>" & vbCrLf _
& "<DIV><FONT color=#ff0000><FONT size=3>-------------------------------------------------------------------------------------------------</FONT> </FONT></DIV>" & vbCrLf _
& "<DIV><FONT color=#ff0000><FONT size=3>This is an automated message from the Visitor System.</FONT> </FONT></DIV>" & vbCrLf _
& "<DIV><FONT color=#ff0000><FONT size=3>Please do not reply to this message.</FONT> </FONT></DIV>" & vbCrLf _
& "<DIV><FONT color=#ff0000><FONT size=3>This message is purely intended for information purposes</FONT> </FONT></DIV>" & vbCrLf _
& "<DIV><FONT color=#ff0000><FONT size=3>Thank you.</FONT> </FONT></DIV>" & vbCrLf _
& "<DIV><FONT color=#ff0000><FONT size=3>-------------------------------------------------------------------------------------------------</FONT> </FONT></DIV>" & vbCrLf _
& "<DIV><FONT color=#0000ff><FONT size=3>Royal Access Control</FONT> </FONT></DIV>" & vbCrLf _
& "<DIV><FONT color=#0000ff><FONT size=3><A href = " & """http://www.RoyalAccess.co.za"">www.RoyalAccess.co.za" & "</A></FONT> </FONT></DIV>" & vbCrLf _
& "<P><FONT color=#0000ff><FONT size=3></FONT> </FONT></P></BODY></HTML>"

Se_Body = "X-Originating-IP: [" & Se_Sender_Ip & "]" & vbCrLf _
& "X-Originating-Email: [" & Se_Email_From & " ]" & vbCrLf _
& "X-Sender: " & Se_Email_From & vbCrLf _
& "X-Priority: " & Se_Priority & vbCrLf _
& "From: " & """" & Se_Sender_Name & """" & " <" & Se_Email_From & ">" & vbCrLf _
& "To: " & Se_Email_To & vbCrLf _
& "Subject: " & Se_Subject & vbCrLf _
& "Date: " & GetDateFormat & vbCrLf _
& "MIME-Version: 1.0" & vbCrLf _
& "Content-Type: multipart/mixed;" & " boundary =" & """" & Boundary & """" & vbCrLf _
& vbCrLf _
& Se_Type_Message & vbCrLf _
& vbCrLf _
& Se_Message_Text & vbCrLf _
& vbCrLf _
& Se_Type_Attach & vbCrLf _
& "." & vbCrLf

'==SEND HALLO (MAX TIMEOUT 30 SECONDS)===
FrmMain.Wnsck.SendData "HELO " & Left(Se_Email_From, InStr(1, Se_Email_From, "@") - 1) & vbCrLf
If GetServerResponse("250", 30) = False Then GoTo errHandlerSendMail

'===SEND FROM===
FrmMain.Wnsck.SendData "MAIL FROM: " & Se_Email_From & vbCrLf
If GetServerResponse("250", 20) = False Then GoTo errHandlerSendMail

'==SEND TO ALL ===
Do While InStr(1, Se_Email_To, ";") <> 0
Npos = InStr(1, Se_Email_To, ";")
Se_Next_to = Trim(Left(Se_Email_To, Npos - 1))
Se_Email_To = Trim(Mid(Se_Email_To, Npos + 1))
If Se_Next_to <> "" Then
FrmMain.Wnsck.SendData "RCPT TO: " & Se_Next_to & vbCrLf
If GetServerResponse("250", 20) = False Then GoTo errHandlerSendMail
End If
Loop

If Se_Email_To <> "" Then FrmMain.Wnsck.SendData "RCPT TO: " & Se_Email_To & vbCrLf
If GetServerResponse("250", 20) = False Then GoTo errHandlerSendMail

'===SEND DATA REQUEST===
FrmMain.Wnsck.SendData "DATA" & vbCrLf
If GetServerResponse("354", 20) = False Then GoTo errHandlerSendMail

'===SEND THE DATA (MAX TIME OUT = 600ms)===
FrmMain.Wnsck.SendData Se_Body
If GetServerResponse("250", 600) = False Then GoTo errHandlerSendMail

'===SEND QUIT===
FrmMain.Wnsck.SendData "QUIT" & vbCrLf
If GetServerResponse("221", 20) = False Then GoTo errHandlerSendMail

'===CLOSE===
If FrmMain.SSTab1.SelectedItem.Index = 1 Then
FrmMain.Lbl_Smtp_Status.Caption = "Message sent."
End If
If FrmMain.SSTab1.SelectedItem.Index = 2 Then
FrmMain.Lbl_Wait_Smtp_Status.Caption = "Message sent."
End If
Idle (200)

FrmMain.Wnsck.Close
By: VGR Date: 15/09/2008 13:48:02 English  Type : Comment
so at least "content-disposition:inline" was a part of the solution 8-)
I'm glad it works now

Nice code

Regards

Do register to be able to answer

 Add This Article To:
 del.icio.usDel.icio.us  diggDigg  googleGoogle  spurlSpurl
 blinkBlink  wongWong  simpySimpy  yahooY! MyWeb 
EContact
browser fav
page generated in 4550.156120 milliseconds

Why Google AdSense ads ?

compteur
 Ranking-Hits PageRank for this page