Quel serveur smtp utiliser pour envoi en masse avec Vba?

Version imprimable

06/03/2017, 00h47
gpoth

1 pièce(s) jointe(s)

Quel serveur smtp utiliser pour envoi en masse avec Vba?

Bonjour,

voilà:
je crée mon répertoire excel, ensuite, je programme mon petit Cdo en Vba...
je crée le site internet et c'est prêt...
je me dis: allez, on fait la pub...

(remarque j'ai pris hostinger comme hébergeur gratuit...)
j'ai un fichier d'email d'environ 3000 personnes

et là j'envoie avec smtp.sfr.... et là je plante à environ 50 mails envoyés...

Pièce jointe 251209

dommage, j'y ai bien cru quelques courts instants...

que me conseillez vous comme serveur smtp ?

Merci.
Guillaume.
06/03/2017, 07h33
Invité

Bonjour,
Ce n'est pas tant le serveur smtp qui importe mais le protocole utiliser!

https://www.developpez.net/forums/d1...t/#post7968025
06/03/2017, 09h38
gpoth

Messagerie coupée

Bonjour,

Que veux-tu dire par protocole ?

Sfr a littéralement bloqué mon compte mail !
Est-ce que cela fonctionne bien avec un compte Hotmail ou Gmail ?

Merci.
06/03/2017, 10h07
joe.levrai

Bonjour,

de mon côté, j'ai pas mal de programmes qui envoient des milliers de mails, je passe par outlook

certes, j'ai une contrainte de 30 mails envoyés par minute, du coup la procédure génère les mails qui se stockent dans ma boite d'envoi, et se libèrent au fur et à mesure, au rythme de 1800 mails par heure.

c'est pas la panacée, mais au moins ça passe.
06/03/2017, 11h33
Invité

Citation:

Que veux-tu dire par protocole ?

tu ouvre ton Outlook ou Mozilla Thunderbird et tu regarde les paramètres SMTP et tu les applique au lien que je t'es donné!

je force excel à attendre 5 secondes avant de créer un nouveau message

bonjour,

merci pour vos réponses...
avec le code suivant, je force Excel à attendre 5 secondes avant de créer le message
ca passe un peu mieux puisque j'arrive à presque 100 message avant que sfr me coupe la connexion
Un message d'erreur too many connection apparaît...

dysorthographie : je n'ai pas bien compris ta nuance dans le code, vérifier le délai d'attente smtp "smtpconnectiontimeout", est-ce bien cela ?

Merci.

Guillaume.

Code:

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
' definit un temps d'attente avant d'envoyer le mail
 
temps_attente = Sheets("serveur").Range("B12").Value
Application.Wait Time + TimeSerial(0, 0, temps_attente)
 
 
 
 
Dim iMsg As Object, iConf As Object, Flds As Object
Set iMsg = CreateObject("cdo.message")
Set iConf = CreateObject("cdo.configuration")
 
Set Flds = iConf.Fields
With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Sheets("serveur").Range("A2").Value
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Sheets("serveur").Range("B2").Value
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Sheets("serveur").Range("C2").Value
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587   'stmp server port changer le numero si necessaire
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False   'Use SSL for the connection (False or True)
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
 
    .Update
End With
 
 
With iMsg
    Set .Configuration = iConf
 
        .From = Sheets("serveur").Range("B2").Value ' Mon Adresse email
        .To = Adresse
 
....

c'est ça le protocole! {Serveur, Identify, SSl, User, PassWord, Port, Delay, Expediteur,} tel que défini dans Outlook ou Mozilla Thunderbird!

Code:

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
Sub test() 
MailEnvoi Sheets("serveur").Range("A2").Value, True, True,Sheets("serveur").Range("B2").Value, Sheets("serveur").Range("C2").Value, 587, 60, Sheets("serveur").Range("B2").Value, Adresse, "", "Suivi des modifications.", "tel truc a été modifile", ""
End Sub
Public Sub MailEnvoi(Serveur, Identify, SSl, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
' sub pour envoyer les mails
Dim msg,Conf,Config,ess,splitPj,IsplitPj
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)
With Config
If Identify = True Then
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = SSl
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PassWord
End If
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Serveur
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = Delay
    .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
    .From = Expediteur
    .Subject = Objet
'
 
    .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
    .Send 'envoi du message
 
End With
' reinitialisation des variables
Set msg = Nothing
Set Conf = Nothing
Set Config = Nothing
 
End Sub

06/03/2017, 16h32
gpoth

merci de votre aide

bonjour,

on va dire.... problème résolu

je suis passé par Gmail
j'ai pu envoyer 1000 messages environ...

espérons maintenant que tous ces messages ne soient pas du spam, sinon ca vaut le coup d'ouvrir une autre discussion!

grand merci à vous
Guillaume.