Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
I think it's not easy when you receive an email with an attachment, example Excel sheet, to open this if you don't have this application in your computer or in your tablet. For this reason, I searched one solution to include directly the pictures in the email.
filePathImg = "C:\temp\Img\"
'First, you have to delete the old files
DeleteFile (filePathImg & "liqudit01.jpg")
'Create the jpg file
ExportObjectToJpg "CH45", filePathImg & "liqudit01.jpg"
'Functions for delete and create the jpg file
Function ExportObjectToJpg( ObjID, fName)
'fonction pour la génération d'images avec un petit timer de 0,2 sec
QvDoc.GetSheetObject(ObjID).ExportBitmapToFile fName
QvDoc.GetApplication.Sleep 200
END Function
FUNCTION DeleteFile(rFile)
'pour effacer les fichiers
set oFile = createObject("Scripting.FileSystemObject")
currentStatus = oFile.FileExists(rFile)
if currentStatus = True Then
oFile.DeleteFile(rFile)
end If
set oFile = Nothing
End Function
'Next it's to prepare email. In this case, I used two tab in the HTML code
'do not forget to introduce this objEmail.AddRelatedBodyPart filePathImg & "liqudit01.jpg", "liquidit01.gif", cdoRefTypeId
'at the end of this function, whithout wont work.
Function MailReport()
'envoi de l'email
Dim objEmail
Const cdoSENDUsingPort = 2 ' Send the message using SMTP
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
CONST cdoNTLM = 2 'NTLM
SMTPServer = "Notes"
CONST SMTPPort = 25 ' Port number for SMTP
CONST SMTPTimeout = 60 ' Timeout for SMTP in seconds
'Sending mail
Set objEmail = CreateObject("CDO.Message")
SET objConf = objEmail.Configuration
SET objFlds = objConf.Fields
WITH objFlds
'---------------------------------------------------------------------
' SMTP server details
.Item("http://schemas.microsoft.com/cdo/configuration/sENDusing") = cdoSENDUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoAnonymous
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = FALSE
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = SMTPTimeout
.Update
'---------------------------------------------------------------------
END With
objEmail.To = EmailTo 'Email Recipient
'objEmail.Cc = EmailCC 'Carbon Copy Recipient
objEmail.From = EmailFrom 'Email Sender
objEmail.SUBject = EmailSubject ' Subject
'objEmail.TextBody = " " 'Text Body
strHTML = "<!DOCTYPE HTML PUBLIC ""-//IETF//DTD HTML//EN"">" & NL
strHTML = strHTML & "<HTML>"
strHTML = strHTML & " <HEAD>"
strHTML = strHTML & " <TITLE>Sample GIF</TITLE>"
strHTML = strHTML & " </HEAD>"
strHTML = strHTML & " <BODY>"
strHTML = strHTML & " <table style=""text-align: left; width: 938px; height: 135px;"" border=""0"""
strHTML = strHTML & " cellpadding=""2"" cellspacing=""2"">"
strHTML = strHTML & " <tbody>"
strHTML = strHTML & " <tr>"
strHTML = strHTML & " <td style=""vertical-align: top;""><IMG src=""liquidit01.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: top;""><br>"
strHTML = strHTML & " <table style=""text-align: left; width: 100%;"" border=""0"""
strHTML = strHTML & " cellpadding=""2"" cellspacing=""2"">"
strHTML = strHTML & " <tbody>"
strHTML = strHTML & " <tr>"
strHTML = strHTML & " <td style=""vertical-align: top;text-align: center;""><big"
strHTML = strHTML & " style=""font-weight: bold; text-decoration: underline; color: rgb(43, 173, 0);font-family: Arial;"">Budget</big><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: bottom;text-align: center;""><span style=""color: rgb(43, 173, 0);font-family: Arial;"">Ventes</span><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: bottom;text-align: center;""><span style=""color: rgb(43, 173, 0);font-family: Arial;"">Achats</span><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: bottom;text-align: center;""><span style=""color: rgb(43, 173, 0);font-family: Arial;"">Salaires</span><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: bottom;text-align: center;""><span style=""color: rgb(43, 173, 0);font-family: Arial;"">Frais généraux</span><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " </tr>"
strHTML = strHTML & " <tr>"
strHTML = strHTML & " <td style=""vertical-align: middle;text-align: center;""><IMG src=""txtrealann.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: top;text-align: center;""><IMG src=""vtann.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: top;text-align: center;""><IMG src=""achann.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: top;text-align: center;""><IMG src=""salann.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: top;text-align: center;""><IMG src=""frgenann.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " </tr>"
strHTML = strHTML & " <tr>"
strHTML = strHTML & " <td style=""vertical-align: middle;text-align: center;""><IMG src=""txmtenc1.gif""><br>"
strHTML = strHTML & " <IMG src=""txmtenc2.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: top;text-align: center;""><IMG src=""vtmenc.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: top;text-align: center;""><IMG src=""achmtenc.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: top;text-align: center;""><IMG src=""salmtenc.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: top;text-align: center;""><IMG src=""frgenmtenc.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " </tr>"
strHTML = strHTML & " </tbody>"
strHTML = strHTML & " </table>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " </tr>"
strHTML = strHTML & " <tr>"
strHTML = strHTML & " <td style=""vertical-align: top;""><IMG src=""client01.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: top;""><IMG src=""client02.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " </tr>"
strHTML = strHTML & " <tr>"
strHTML = strHTML & " <td style=""vertical-align: top;""><IMG src=""four01.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " <td style=""vertical-align: top;""><IMG src=""four02.gif""><br>"
strHTML = strHTML & " </td>"
strHTML = strHTML & " </tr>"
strHTML = strHTML & " </tbody>"
strHTML = strHTML & " </table>"
strHTML = strHTML & " </BODY>"
strHTML = strHTML & "</HTML>"
objEmail.HTMLBody = strHTML
objEmail.AddRelatedBodyPart filePathImg & "liqudit01.jpg", "liquidit01.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "client01.jpg", "client01.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "client02.jpg", "client02.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "four01.jpg", "four01.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "four02.jpg", "four02.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "txmtenc1.jpg", "txmtenc1.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "txmtenc2.jpg", "txmtenc2.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "vtmenc.jpg", "vtmenc.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "achmtenc.jpg", "achmtenc.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "salmtenc.jpg", "salmtenc.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "frgenmtenc.jpg", "frgenmtenc.gif", cdoRefTypeId
'objEmail.AddRelatedBodyPart filePathImg & "coursdev.jpg", "coursdev.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "vtann.jpg", "vtann.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "achann.jpg", "achann.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "salann.jpg", "salann.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "frgenann.jpg", "frgenann.gif", cdoRefTypeId
objEmail.AddRelatedBodyPart filePathImg & "txtrealann.jpg", "txtrealann.gif", cdoRefTypeId
objEmail.SEND
SET objFlds = Nothing
SET objConf = Nothing
SET objEmail = Nothing
End Function
Very good, but when you want to read this email using an IPAD, it's not good. All pictures are in the bottom in the email and you have just the frame without the pictures.
I found a solution. You have to convert all pictures in Base64 and include these pictures converted in your email. After that all is ok.
The VB scipt I created is that
' an example how to convert
strHTML = strHTML & | codeb64(filePathImg+"vtrealymm1.jpg") & "<br>" |
' function to convert the jpg picture
Function codeb64(infile)
' This script reads jpg picture named SuperPicture.jpg, converts it to base64
' code using encoding abilities of MSXml2.DOMDocument object and saves
' the resulting data to encoded.txt file
Const fsDoOverwrite = true ' Overwrite file with base64 code
Const fsAsASCII = false ' Create base64 code file as ASCII file
Const adTypeBinary = 1 ' Binary file is encoded
' Variables for writing base64 code to file
Dim objFSO
Dim objFileOut
' Variables for encoding
Dim objXML
Dim objDocElem
' Variable for reading binary picture
Dim objStream
' Open data stream from picture
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = adTypeBinary
objStream.Open()
objStream.LoadFromFile(infile)
' Create XML Document object and root node
' that will contain the data
Set objXML = CreateObject("MSXml2.DOMDocument")
Set objDocElem = objXML.createElement("Base64Data")
objDocElem.dataType = "bin.base64"
' Set binary value
objDocElem.nodeTypedValue = objStream.Read()
'Prépare la variable pour le code HTML
codeb64 = "<img src=""data:image/jpg;base64," + objDocElem.text + """/>"
' Clean all
Set objFSO = Nothing
Set objFileOut = Nothing
Set objXML = Nothing
Set objDocElem = Nothing
Set objStream = Nothing
End Function