Languages :: Visual Basic :: Visual Basic 6 With MIME FORMAT Html Mail and embedded image |
|||
| By: JacquesVdm |
Date: 05/06/2008 14:27:09 |
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 | 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 | 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 | 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 | 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 | 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 | 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: | |||
| |
|
|
|
| |
|
|
|









