Un grand merci au concepteur de http://www.sepa-convertir.eu qui nous livre ses recherches sur l’objet CDO.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 |
<% 'Format HTML Texte = "TOTO TITI TATA" 'Format non html Msg = "TOTO TITI TATA" & vbcrlf '============================= 'For the priority '============================ Const cdoPriorityNonUrgent= -1 ' Nonurgent priority Const cdoPriorityNormal= 0 ' Normal priority Const cdoPriorityUrgent= 1 'Urgent priority '=============================== 'For the importance of the mail '=============================== Const cdoLow= 0 ' Low importance Const cdoNormal= 1 ' Normal importance Const cdoHigh= 2 ' High importance '==================================== 'For the sensitivity of the mail '================================= Const cdoSensitivityNone= 0 ' None Const cdoPersonal = 1 ' Personal Const cdoPrivate = 2 ' Private Const cdoCompanyConfidential = 3 ' Company Confidential Const CdoReferenceTypeName = 1 '================================================ ' Beginning of paramters '================================================ ToAddress = "toto@toto.fr" ' destinataire de l'email ---Obligatoire Subject = "SEPA-CONVERTIR.EU : Renseignements" ' Objet de l' email '============================= SmtpServer = "smtp.toto.fr" 'adresse du serveur smtp -- Obligatoire Password = "titi" 'Mot de passe de votre compte email FromName= " Jean DURAND" ' Nom de la personne qui envoie l'email FromAdress = "toto@toto.fr" ' addresse de l'expéditeur '======================= CcAddress = "" ' addresse pour carbon copy - laisser à blanc si pas necessaire BccAddress = "" ' addresse pour block carbon copy - laisser à blanc si pas necessaire Username = "toto@toto.fr" ' adresse du compte mail depuis lequel le courriel est envoyé Obligatoire ' port utilise pour envoyer le mail ex 25 pour un provider normal ou 465 pour gmail IPPort = 25 ' si ssl IPPort = 465 ssl = 0 '0 si vous n'utilisez pas ssl ou 1 si vous utilisez ssl ex pour gmail AttachFiles= "" 'liste des fichiers attaches que vous souhaitez envoyer (chemin physique de chaque fichier + nom + separe par des ;" replyto = FromAdress 'adresse email souhaitée pour la réponse au mail dispositionnotificationTo = FromAdress 'adresse souhaitée pour l'accusé de réception ReturnreceiptTo=FromAdress ' email si vous souhaitez avoir l'accusé de réception Importance = cdoHigh 'Haute importance; Priotité d'envoi du message : "High=2", "Normal"=1, "Low=0" Priorite = cdoPriorityUrgent 'Priorité urgente sensitivity = cdoCompanyConfidential ' degré de confidentialité transfert = 0 ' 0 Ne pas transférer 1 Transfert libre '======================================================= ' End of paramters '====================================================== Set objemail = CreateObject("CDO.Message") If IsObject(objemail) then objeMail.BodyPart.charset = "utf-8" Set iConf = CreateObject("CDO.Configuration") objemail.Configuration= iconf objemail.MimeFormatted= True objemail.to= ToAddress objEmail.From = Chr(34) &FromName & Chr(34)&"<" & FromAdress& ">" objemail.Subject= Subject 'Pour le texte en HTML objemail.HTMLBody= Texte 'Si le mailer n'est pas HTML objemail.TextBody = Msg objemail.replyTo= replyto If CcAddress <> "" Then objemail.Cc = CcAddress End If If BccAddress <> "" then objemail.Bcc = BccAddress End If objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")= 2 objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")= SmtpServer If IPPort = 0 then IPPort = 25 End If objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")= IPPort 'Authenticated SMTP If Username <> "" then objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")= 1 objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername")= Username objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword")= Password End If If ssl then objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl")= 2 End If 'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server) objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout")= 60 objeMail.Configuration.Fields.Update '================== ' sensitivity '================ Select case sensitivity Case cdoCompanyConfidential objemail.Fields.Item("urn:schemas:mailheader:Sensitivity") = "Company-Confidential" Case cdoPersonal objemail.Fields.Item("urn:schemas:mailheader:Sensitivity") = "Private" Case cdoPrivate objemail.Fields.Item("urn:schemas:mailheader:Sensitivity") = "Personal" Case cdoSensitivityNone objemail.Fields.Item("urn:schemas:mailheader:Sensitivity") = "None" End Select Select case transfert Case 0 objemail.Fields.Item("urn:schemas:mailheader:X-Message-Flag") = "Ne pas Transferer" Case 1 oobjemail.Fields.Item("urn:schemas:mailheader:X-Message-Flag") = "Transfert Libre" End Select objemail.Configuration.Fields.Update Select case Priorite Case cdoPriorityUrgent objemail.Fields("urn:schemas:mailheader:X-MSMail-Priority") = "High" objemail.Fields("urn:schemas:mailheader:X-Priority") = CStr(cdoPriorityUrgent) objemail.Fields("Fields('urn:schemas:mailheader:priority") = CStr(cdoPriorityUrgent) Case cdoPriorityNormal objemail.Fields("urn:schemas:mailheader:X-MSMail-Priority") = "Normal" objemail.Fields("urn:schemas:mailheader:X-Priority") = CStr(cdoPriorityNormal) objemail.Fields("Fields('urn:schemas:mailheader:priority") = CStr(cdoPriorityNormal) Case cdoPriorityNonUrgent objemail.Fields("urn:schemas:mailheader:X-MSMail-Priority") = "Low" objemail.Fields("urn:schemas:mailheader:X-Priority") = CStr(cdoPriorityNonUrgent) objemail.Fields("urn:schemas:mailheader:priority") = CStr(cdoPriorityNonUrgent) End Select Select case Importance Case cdoHigh objemail.Fields.Item("urn:schemas:httpmail:importance") = cdoHigh Case cdoNormal objemail.Fields.Item("urn:schemas:httpmail:importance") = cdoNormal Case cdoLow objemail.Fields.Item("urn:schemas:httpmail:importance") = cdoLow End Select If dispositionnotificationTo <> "" then objemail.Fields("urn:schemas:mailheader:disposition-notification-to")= dispositionnotificationTo end if If ReturnreceiptTo <> "" then objemail.Fields("urn:schemas:mailheader:return-receipt-to")= ReturnreceiptTo end if If dispositionnotificationTo <> "" or ReturnreceiptTo <> "" then 'Update settings objemail.Fields.Update end if 'Déclaration des "inline attachments" Permet d'inclure des images dans le corps du mail Path = Server.MapPath("/image/") Set objbodypart = objemail.AddRelatedBodyPart( Path& "\fond.gif" ,"fond.gif",CdoReferenceTypeName) objbodypart.Fields("urn:schemas:mailheader:Content-ID") = "<fond.gif>" objbodypart.Fields.Item("urn:schemas:mailheader:Content-Disposition") = "inline" objbodypart.Fields.Update Set objbodypart1 = objemail.AddRelatedBodyPart(Server.MapPath("/image/logo.gif") ,"logo.gif",CdoReferenceTypeName) objbodypart1.Fields("urn:schemas:mailheader:Content-ID") = "<logo.gif>" objbodypart1.Fields.Item("urn:schemas:mailheader:Content-Disposition") = "inline" objbodypart1.Fields.Update Set objbodypart2 = objemail.AddRelatedBodyPart(Server.MapPath("/image/toto.vcf") ,"sepa.vcf",CdoReferenceTypeName) objbodypart2.Fields("urn:schemas:mailheader:Content-ID") = "<toto.vcf>" objbodypart2.Fields.Item("urn:schemas:mailheader:Content-Disposition") = "inline" objbodypart2.Fields.Update ' Sending attach files If AttachFiles <> "" then Resultat= Split(AttachFiles, ";") for each x in resultat objemail.AddAttachment (x) Next End If 'objEmail.DSNOptions = 14 objemail.Send Set iconf=nothing Set objbodypart= Nothing set objbodypart1=Nothing set objbodypart2=Nothing set objemail= Nothing Else Response.write "Sorry - Erreur de creation de l'objet" End if %> |
Please follow and like us:
