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
| Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
const SSL=false
'Delivery Status Notifications
Const cdoDSNDefault = 0 'None
Const cdoDSNNever = 1 'None
Const cdoDSNFailure = 2 'Failure
Const cdoDSNSuccess = 4 'Success
Const cdoDSNDelay = 8 'Delay
Const cdoDSNSuccessFailOrDelay = 14 'Success, failure or delay
const Serveur="MyServeur"
const User="MyUser"
const PassWord="MyPassWord"
const Port=25
const Delay=10
const Expediteur="MyExpediteur@MyEbergeur.fr"
const Dest="MyDest@MyEbergeur.fr"
const DestEnCopy="MyDestEnCopy@MyEbergeur.fr"
const DestEnCopyCaher="MyDestEnCopyCaher@MyEbergeur.fr"
const Objet="Je te parle de:"
const Body= "Je vous parle dun temps que les moins de vingt ans ne peuvent pas connaître"
'const Pj="c:\Pièce_jointe.PDF"
const Pj=""
EnvoiMailSmtp Serveur, cdoAnonymous,SSL,User,PassWord,Port , Delay,cdoDSNDefault, Expediteur, Dest, DestEnCopy, Objet,Body,Pj
'**************************************************************************************************************************************************************************************************************
Public Sub MailEnvoi(Serveur, Identify , SSL, User, PassWord, Port, Delay,cdoDSN, Expediteur, Dest, DestEnCopy,DestEnCopyCaher, Objet, Body, Pj)
' sub pour envoyer les mails
Dim msg
Dim Conf
Dim Config
Dim splitPj
Dim IsplitPj
dim schema
Set msg = CreateObject("CDO.Message") 'pour la configuration du message
Set Conf = CreateObject("CDO.Configuration") ' pour la configuration de l'envoi
Dim strHTML
Set Config = Conf.Fields
' Configuration des parametres d'envoi
'(SMTP - Identification - SSL - Password - Nom Utilisateur - Adresse messagerie)
schema = "http://schemas.microsoft.com/cdo/configuration/" 'smtpusessl
With Config
If Identify <> 0 Then
.Item(schema & "smtpusessl") =SSL
.Item(schema & "smtpusetls") = 1
.Item(schema & "smtpauthenticate") = Identify
.Item(schema & "sendusername") = User
.Item(schema & "sendpassword") = PassWord
end if
.Item(schema & "smtpserverport") = Port
.Item(schema & "sendusing") = 2
.Item(schema & "smtpserver") = Serveur
.Item(schema & "smtpconnectiontimeout") = Delay
.Item(schema & "enablessl") = 1
.Update
End With
'Configuration du message
'If E_mail.Sign.Value = Checked Then Convert ServeurFrm.SignTXT, ServeurFrm.Text1
With msg
Set .Configuration = Conf
.To = Dest
.cc = DestEnCopy
.bcc= Expediteur & ";" & DestEnCopyCaher
.bcc=DestEnCopyCaher
.FROM = Expediteur
.Subject = Objet
.DSNOptions = cdoDSN
'
.htmlbody = Body '"<p align=""center""><font face=""Verdana"" size=""1"" color=""#9224FF""><b><br><font face=""Comic Sans MS"" size=""5"" color=""#FF0000""></b><i>" & body & "</i></font> " 'E_mail.ZThtml.Text
If Pj <> "" Then
splitPj = Split(Pj & ";", ";")
For IsplitPj = 0 To UBound(splitPj)
If Trim("" & splitPj(IsplitPj)) <> "" Then
.AddAttachment Trim("" & splitPj(IsplitPj))
End If
Next
End If
on error resume next
.Send 'envoi du message
if err<>0 then
msgbox err.description
else
msgbox "Fin"
end if
End With
' reinitialisation des variables
Set msg = Nothing
Set Conf = Nothing
Set Config = Nothing
End Sub |
Partager