Email CDO par VBA_Excel Résolu/Fermé

Question

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
Configuration: Windows / Firefox 51.0

gbinforme · Answer

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 ?

gbinforme · Answer

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://www.serversmtp.com/fr/serveur-smtp-bluewin/
Essaie de vérifier si tu es bien avec les bons.

thev · Answer

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
nnnnn\Documents\classeur1.xls")    cdo_msg.Send    'libération objet message    Set cdo_msg = NothingEnd Sub

ruelp934 · Answer

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.

michel_m · Answer

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") ' archivesobjMessage.bcc = Range("cci1")
 Michel

pierruel · Answer

Bonsoir et merci  Michel_M,
C'est une bonne idée que je vais tester sans retard.
Cordialement
Pierre

pierruel · Answer

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 multiplesSub EnvoiMail() 'par thev sur Comment ça marche 'Add the Project Reference Microsoft CDO WINDOWS FOR 2000Dim destinataire, Sujet As StringDim Email_adresse As StringDim nom, prenom As VariantDim secondes, numero, saut As IntegerDim attente As VariantDim Corps, nombre As StringDim ligne, colonne, lig, col As Integerligne = 1colonne = 3lig = 1col = 6nombre = Cells(1, 8).Valuenumero = Len(nombre) + 12saut = 1Dim adresse_mail As String'sélection des adressesadresse_mail = ""ThisWorkbook.Sheets("donnees").ActivateDo While Cells(ligne, 3).Value <> ""If Cells(ligne, 3).Value <> "" And Cells(ligne, 3).Value Like "?*@?*.?*" Then adresse_mail = Cells(ligne, 3).ValueEnd IfCells(ligne, 3).Activate prenom = ActiveCell.Offset(0, -1).Value nom = ActiveCell.Offset(0, -2).ValueCorps = "Mon cher" & " " & prenom & " " & nom & Chr(10)'tirage au sort des durées d'attenteRandomizesecondes = Int((3 * Rnd) + 2)If secondes <= 9 Thenattente = "0:00:0" & secondesElseIf secondes >= 10 Thenattente = "0:00:" & secondesEnd IfEnd If'récupération du sujetSujet = ThisWorkbook.Sheets("donnees").Cells(1, 4).Value _& " " & "(le numéro" & " " & numero & ")"'composition du texte du corpsThisWorkbook.Sheets("donnees").ActivateDo While Cells(lig, 6).Value <> ""Corps = Corps & " " & Cells(lig, col).Valuelig = lig + 1Loop'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.Sendligne = ligne + 1lig = 1Cells(1, 8).Value = nombre & "x"saut = saut + 1Loop 'libération objet message Set cdo_msg = NothingEnd Sub Cordialement Pierre

Email CDO par VBA_Excel

7 réponses

Discussions similaires