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
| function SendEmail(From, too, copyto, hideCopyto, Subject, Body, AttachFile, Format)
On error resume next
'DECLARATIONS
Dim objConfig ' As CDO.Configuration
Dim objMessage ' As CDO.Message
Dim Fields ' As ADODB.Fields
if MAIL_XPRIORITY = "" then MAIL_XPRIORITY = 1 'Basse = 0 ; Normal = 1(défaut) ; Haute = 2
'MAIL-NOTIFICATION-TO
'CONSTANTES
Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cdoSendUsingPort = 2
Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Const cdoBasic = 1
Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Const cdoUseSSL = "http://schemas.microsoft.com/cdo/configuration/smtpusessl"
' Get a handle on the config object and it's fields
Set objConfig = Server.CreateObject("CDO.Configuration")
Set Fields = objConfig.Fields
' Set config fields we care about
With Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = SMTP_SERVER
.Item(cdoSMTPServerPort) = SMTP_PORT
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSendUserName) = ACCOUNT_USER
.Item(cdoSendPassword) = PWD_USER
.Item(cdoSMTPConnectionTimeout) = 60
.Item(cdoUseSSL) = false
.Update
End With
Set objMessage = Server.CreateObject("CDO.Message")
Set objMessage.Configuration = objConfig
'CONTENT MAIL CREATION
if err.number = 0 then
with objMessage
set .Configuration = objConfig
.subject = Subject
.From = From
.To = Too
.Bcc = hidecopyto
.cc = copyto
select case format
case 0 : .TextBody = Body 'SIMPLE TEXT
case 1 : .HTMLBody = Body 'HTML TEXT
case 2 : .CreateMHTMLBody = Body 'PUBLIC OR PRIVATE PAGE
end select
'Set importance or Priority to high
.Fields("urn:schemas:httpmail:importance" ).value = MAIL_XPRIORITY
' Request read receipt
if MAIL_NOTIFICATION_TO <> "" then
.Fields("urn:schemas:mailheader:disposition-notification-to") = MAIL_NOTIFICATION_TO
end if
REM --- Envoi multiples
if AttachFile <> "" then
fic=split(AttachFile,"|")
for f = lbound(fic) to ubound(fic)
if fic(f) <> "" then .AddAttachment fic(f)
next
end if
'.TextBodyPart.Charset = "utf-8"
.BodyPart.Charset = "utf-8"
.Fields.update
.Send
End With
end if
Set Fields = Nothing
Set objMessage = Nothing
Set objConfig = Nothing
SendEmail=err.number
if err.number <> 0 then
session("ErrorSendEmail")=err.description
end if
err.clear
end function |
Partager