Envoie de mails CDO

Yersin · 25/08/2011, 15h20

Bonjour à tous,

Je tente d’envoyer des mails à partir d’Excel par une procédure CDO avec le bout de code suivant (récupéré et adapté à partir du forum).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Const Expediteur = "<toto@taf.fr>"
Public Const MAIL_SENDUSING = 2
Public Const MAIL_AUTHENTICATE = 1
Public Const MAIL_CPT_SENDUSR = "Login"
Public Const MAIL_CPT_SENDPASS = "Motdepasse"
Public Const MAIL_SMTP_SERVER = "<serveur smtp>"
Public Const MAIL_SMTP_SERVERPORT = 587
 
Sub CDO_Snd(Destinataire As String, Titre As String, Corps As String)
On Error GoTo Sortie_Erreur
    Dim i As Long
    Dim objEmail As Object
 
    Set objEmail = CreateObject("CDO.Message") 'Crée un objet mail
 
    objEmail.From = Expediteur
    objEmail.To = Destinataire
    objEmail.Subject = Titre
    objEmail.TextBody = Corps
 
    With objEmail.Configuration.Fields
        .Item(CdoConfiguration.cdoSendUsingMethod) = MAIL_SENDUSING
        .Item(CdoConfiguration.cdoSMTPAuthenticate) = MAIL_AUTHENTICATE
        .Item(CdoConfiguration.cdoSendUserName) = MAIL_CPT_SENDUSR
        .Item(CdoConfiguration.cdoSendPassword) = MAIL_CPT_SENDPASS
        .Item(CdoConfiguration.cdoSMTPServer) = MAIL_SMTP_SERVER
        .Item(CdoConfiguration.cdoSMTPServerPort) = MAIL_SMTP_SERVERPORT
        .Update
    End With
    objEmail.Send
Exit Sub
Sortie_Erreur:
    MsgBox Err.Description
End Sub

Toutefois, j’ai systématiquement le message d’erreur « Le transport a échoué dans sa connexion au serveur ».

Je pense que cela peut venir du fait que nous utilisons un serveur Exchange mais je ne sais pas comment contourner ce problème.

En vous remerciant par avance pour l’aide que vous pourrez m’apporter,

Yersin

pc75 · 25/08/2011, 16h38

Bonjour,

Voila un bout de code qui fonctionne chez moi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Set oMail = CreateObject("CDO.Message")
Set oMailConfig = CreateObject ("CDO.Configuration")
 
oMailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "XXXXX" ' Nom du serveur SMTP
oMailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 ' Port utilisé
oMailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ' On utilise un service SMTP
oMailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 ' Timeout
oMailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 ' 0 = aucune authentification ; 1 = authentification
oMailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "USER" ' Utilisateur exchange si authentification = 1
oMailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "PWD" ' Mot de passe de l'utilisateur exchange si authentification = 1
oMailConfig.Fields.Update
Set oMail.Configuration = oMailConfig
oMail.Sender = "Expéditeur"
oMail.From = "FROM"
oMail.Fields.Update()
oMail.Subject = "Sujet")
oMail.To = "Destinataires")
oMail.CC = "Destinataires CC"
oMail.BCC = "Destinataires BCC"
Body = ""
Body = Body & "<html>"
Body = Body & "<body>"
Body = Body & "Le texte du message"
Body = Body & "</body>"
Body = Body & "</html>"
 
oMail.HTMLBody = Body
 
oMail.Send
Set oMailConfiguration = Nothing
Set oMailConfig = Nothing
Set oMail = Nothing

Yersin · 25/08/2011, 17h08

Bonjour pc75,

Je viens de testé ta solution mais j'ai toujours le même message d'erreur au moment du "Send".

OutLook est installlé sur l'ordi et arrive à envoyer des mails via Exchange.

N'y aurait-il pas un moyen de récupérer les infos dont dispose OutLook pour les réutiliser dans la macro?

Yersin

25/08/2011, 17h08	#3
Yersin Futur Membre du Club Consultant MOA Inscription : août 2011 Messages : 16 Détails du profil Informations personnelles : Sexe : Localisation : France, Paris (Île de France) Informations professionnelles : Activité : Consultant MOA Secteur : Administration - Collectivité locale Informations forums : Inscription : août 2011 Messages : 16 Points : 16 Points : 16	Bonjour pc75, Je viens de testé ta solution mais j'ai toujours le même message d'erreur au moment du "Send". OutLook est installlé sur l'ordi et arrive à envoyer des mails via Exchange. N'y aurait-il pas un moyen de récupérer les infos dont dispose OutLook pour les réutiliser dans la macro? Yersin
	00

Outils de la discussion
Afficher une version imprimable Envoyer un lien vers cette page par email