Email CDO par VBA_Excel Résolu

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 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

Email CDO par VBA_Excel

7 réponses

Discussions similaires

Newsletters