Email CDO par VBA_Excel [Résolu/Fermé]

Signaler
Messages postés
13
Date d'inscription
mardi 4 juin 2013
Statut
Membre
Dernière intervention
22 février 2017
-
Messages postés
13
Date d'inscription
mardi 4 juin 2013
Statut
Membre
Dernière intervention
22 février 2017
-
Bonjour,
J'ai copié le code proposé par lermite222 il y a 4 ou 5 ans, j'ai copié les paramètres serveur smtp sur Thunderbird installé sur mon PC mais j'ai toujours l'un des 2 msg d'erreur suivants:
- le message a échoué dans la connexion au serveur ou
- le serveur a répondu "not available.
Comme je n'étais pas sûr de mon affaire j'ai fait l'essai avec
- 2 valeurs pour smtpusing
- 3 mots de passe différents
- 3 numéros de port smtp différents
sans rien améliorer.
Quelle autre erreur ai-je faite ?
Merci d'avance
Cordialement
Pierre



7 réponses

Messages postés
14934
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 193
Bonjour,

Cette procédure fonctionne très bien mais il faut mettre les paramètres SMTP adaptés au serveur que tu utilises.
Tu regardes sur le site les codes qui sont exigés et tu les renseigne en conséquence : tu utilises quel serveur ?
Messages postés
13
Date d'inscription
mardi 4 juin 2013
Statut
Membre
Dernière intervention
22 février 2017

Bonjour gbinforme,
Merci beaucoup pour ton aide.
J'utilise Thunderbird comme client de messagerie et le site du serveur est bluewin.ch. Pour que je comprenne bien: est-ce que je dois aller voir sur le site de Thunderbird ou sur celui de Bluewin.ch ? Pour le moment j'ai copié les paramètres enregistrés dans Thunderbird (nom du serveur smtp + nom d'utilisateur) + le mot de passe enregistré sur le site de Bluewin.ch (il n'apparaît pas dans Thunderbird). Que faire de plus ?
Merci d'avance,
Bonne fin de semaine.
Cordialement
Pierre
Messages postés
14934
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 193
Bonjour,

J'utilise Thunderbird comme client de messagerie
Cela n'a aucune importance car la procédure n'utilise pas le client de messagerie.

Si tes email peuvent être envoyés avec Thunderbird, c'est normal de mettre les mêmes paramètres dans la procédure et cela devrait fonctionner.

Tu as les codes officiels ici
https://serversmtp.com/fr/serveur-smtp-bluewin/

Essaie de vérifier si tu es bien avec les bons.
Messages postés
13
Date d'inscription
mardi 4 juin 2013
Statut
Membre
Dernière intervention
22 février 2017

Bonsoir gbinforme,
J'ai fait tout ça, mais ça se complique.
Comme je le disais au départ, j'ai copié la demo de lermitte122 sous fichespratiques>programmation>langages>VBA, je l'ai testée en remplaçant les masques par mes paramètres et pour finir je l'ai testée telle quelle, sans rien modifier. Dans *tous* les cas (je veux dire: avec ou sans mes paramètres) j'obtiens le message d'erreur "paramètre sendusing invalide".
Or je crois savoir que ce paramètre ne peut prendre que 2 valeurs, soit 1 ou 2: je les ai essayées toutes les deux et le message d'erreur n'a pas changé. J'ai de la peine à comprendre, est-ce que l'auteur ou quelqu'un d'autre peut m'expliquer ce qui se passe ?
Merci d'avance.
Cordialement
Pierre
Messages postés
14934
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 193
Bonsoir,
Ce code fonctionne pour plusieurs serveurs aussi pour comprendre où est le souci, il te faut dérouler le code pas à pas avec F8 et tu verras ce qui coince.
Messages postés
1769
Date d'inscription
lundi 7 avril 2008
Statut
Membre
Dernière intervention
15 juin 2020
540
Bonjour,

Ce code que j'ai développé et déjà fourni fonctionne parfaitement avec un compte Gmail et donc avec le serveur smtp.gmail.com .

Sub EnvoiMail()
'Add the Project Reference Microsoft CDO WINDOWS FOR 2000
Dim cdo_msg As New CDO.Message

'configuration message
cdo_msg.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
cdo_msg.Configuration.Fields(cdoSMTPConnectionTimeout) = 60
cdo_msg.Configuration.Fields(cdoSendUsingMethod) = cdoSendUsingPort
cdo_msg.Configuration.Fields(cdoSMTPServerPort) = 465
cdo_msg.Configuration.Fields(cdoSMTPAuthenticate) = cdoBasic
cdo_msg.Configuration.Fields(cdoSMTPUseSSL) = True
cdo_msg.Configuration.Fields(cdoSendUserName) = "xxxxxxxxxx@gmail.com"
cdo_msg.Configuration.Fields(cdoSendPassword) = "ppppppppp"
cdo_msg.Configuration.Fields.Update

'remplissage et envoi message
cdo_msg.To = "adresse1"
cdo_msg.From = "adresse2"
cdo_msg.Subject = "filename Sent to www.???.com "
cdo_msg.TextBody = "File FTP LOG ATTACHED."
cdo_msg.AddAttachment ("C:\Users\nnnnnn\Documents\classeur1.xls")
cdo_msg.Send

'libération objet message
Set cdo_msg = Nothing
End Sub


 
Bonjour et merci à gbinforme et à thev,
Comme j'ai déjà essayé d'adapter une quinzaine de codes garantis fonctionnels aux paramètres de ma messagerie sans aucun succès, j'ai adopté le code de thev (merci) et au lieu de bidouiller je me suis créé une messagerie chez Gmail (puisque ce code est sur mesure pour Gmail).
Seul souci: mon intention était de faire des envois e n série, pour mon premier essai 10 destinataires) mais seuls les 5 premiers ont reçu le msg, ce qui me fait penser que Gmail bloque ce genre d'envois. Pourtant j'avais programmé des temps d'attente différents entre 2 envois consécutifs. Pourtant je n'ai pas vu ce genre d'interdiction dans les conditions générales de Gmail. Qu'en pensez-vous ?
En tout cas merci de l'aide que vous m'avez fournie jusqu'ici.
Messages postés
16250
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
19 octobre 2020
3 051
Bonjour

En mettant la liste de tes destinataires dans une cellule( ici nommée "cci1"), tu pourrais utiliser la méthode "Bcc" pour envoyer tes messages en 1 seule fois

a adapter (tiré de mon grenier)
objMessage.Subject = Range("sujet")
objMessage.From = Range("emetteur")
objMessage.to = Range("destinataire") ' archives
objMessage.bcc = Range("cci1")

 Michel
Messages postés
13
Date d'inscription
mardi 4 juin 2013
Statut
Membre
Dernière intervention
22 février 2017

Bonsoir et merci Michel_M,
C'est une bonne idée que je vais tester sans retard.
Cordialement
Pierre
Messages postés
13
Date d'inscription
mardi 4 juin 2013
Statut
Membre
Dernière intervention
22 février 2017

Encore merci à Thev,
J'ai adapté ton code à mes besoins:
- envois individuels à une série de destinataires
- temps d'attente variable aléatoirement entre les envois.
-adjonction de 2 pièces jointes
Comme le tout s'inscrit dans une boucle Do While, les 2 annexes étaient ajoutées à chaque itération, d'où
2ème envoi: 4 annexes
3ème envoi: 6 annexes, etc.
Donc adjonction d'un saut conditionnel "par dessus" l'ajout des annexes, dès le 2ème envoi.
Pour mes essais: numéroteur d'envois (variable numero).
Sur la feuille "donnees", j'ai:
colonne A nom de faamille
col B prénom
col C adresse e-mail
cellule D1 Sujet
cellules F1 à F10 éléments du corps
cellule H1: enregistrement des envois (pour numérotation). Je joins le code pour qui en aurait l'usage
Option Explicit


'ver 8 (d'après le code de thev sur CCM) avec
'a) série d'adresses individualisées
'b) durée variable entre les envois
'c) composition du corps du texte
'd) élimination des annexes multiples

Sub EnvoiMail() 'par thev sur Comment ça marche
'Add the Project Reference Microsoft CDO WINDOWS FOR 2000
Dim destinataire, Sujet As String
Dim Email_adresse As String
Dim nom, prenom As Variant
Dim secondes, numero, saut As Integer
Dim attente As Variant
Dim Corps, nombre As String
Dim ligne, colonne, lig, col As Integer
ligne = 1
colonne = 3
lig = 1
col = 6

nombre = Cells(1, 8).Value
numero = Len(nombre) + 12

saut = 1
Dim adresse_mail As String

'sélection des adresses
adresse_mail = ""
ThisWorkbook.Sheets("donnees").Activate
Do While Cells(ligne, 3).Value <> ""
If Cells(ligne, 3).Value <> "" And Cells(ligne, 3).Value Like "?*@?*.?*" Then
adresse_mail = Cells(ligne, 3).Value
End If
Cells(ligne, 3).Activate
prenom = ActiveCell.Offset(0, -1).Value
nom = ActiveCell.Offset(0, -2).Value

Corps = "Mon cher" & " " & prenom & " " & nom & Chr(10)

'tirage au sort des durées d'attente
Randomize
secondes = Int((3 * Rnd) + 2)
If secondes <= 9 Then
attente = "0:00:0" & secondes
Else
If secondes >= 10 Then
attente = "0:00:" & secondes
End If
End If

'récupération du sujet
Sujet = ThisWorkbook.Sheets("donnees").Cells(1, 4).Value _
& " " & "(le numéro" & " " & numero & ")"

'composition du texte du corps
ThisWorkbook.Sheets("donnees").Activate
Do While Cells(lig, 6).Value <> ""
Corps = Corps & " " & Cells(lig, col).Value
lig = lig + 1
Loop
'MsgBox ("le corps contient" & Corps)

Dim cdo_msg As New CDO.Message

'configuration message
cdo_msg.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
cdo_msg.Configuration.Fields(cdoSMTPConnectionTimeout) = 60
cdo_msg.Configuration.Fields(cdoSendUsingMethod) = cdoSendUsingPort
cdo_msg.Configuration.Fields(cdoSMTPServerPort) = 465
cdo_msg.Configuration.Fields(cdoSMTPAuthenticate) = cdoBasic
cdo_msg.Configuration.Fields(cdoSMTPUseSSL) = True
cdo_msg.Configuration.Fields(cdoSendUserName) = "mon_ID@gmail.com"
cdo_msg.Configuration.Fields(cdoSendPassword) = "mon_PW"
cdo_msg.Configuration.Fields.Update

Application.Wait (Now + TimeValue(attente))

'remplissage et envoi message
cdo_msg.To = adresse_mail
cdo_msg.From = "mon_ID@gmail.com"
'cdo_msg.CC = "dest. copie"
'cdo_msg.BCC = "dest_copie_cachée"
cdo_msg.Subject = Sujet
cdo_msg.TextBody = Corps
If saut > 1 Then
GoTo envoi
End If
cdo_msg.AddAttachment ("E:\2_M_E_S__P_R_O_J_E_T_S\LeCourant\e_mailing\Annexe_bidon1.doc")
cdo_msg.AddAttachment ("E:\2_M_E_S__P_R_O_J_E_T_S\LeCourant\e_mailing\Annexe_bidon2.doc")
envoi:
cdo_msg.Send
ligne = ligne + 1
lig = 1
Cells(1, 8).Value = nombre & "x"
saut = saut + 1
Loop

'libération objet message
Set cdo_msg = Nothing
End Sub


Cordialement
Pierre