Bonjour au forum,
Voilà , je travaille sur un projet de mailing mais je rencontre différentes erreurs.
Pour commencer, les mails ne partent pas !
Pourquoi, ai-je oublié quelque chose ?
Merci
Stephanie
Bonjour au forum,
Voilà , je travaille sur un projet de mailing mais je rencontre différentes erreurs.
Pour commencer, les mails ne partent pas !
Pourquoi, ai-je oublié quelque chose ?
Merci
Stephanie
Bonjour,
Sympathique projet, qui est à l'origine de ce code ?
Chez moi cela part bien j'ai bien sûr changé le serveur smtp. par contre c'est ta gestion d'erreur qui te fait croire que ca ne marche pas.
Attention aussi à un éventuel proxy.
edit :
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
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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137 Private Sub Btn_Newsletter_Click() Dim strHTML As String Me.Message = "Envoi en cours patientez..." If MsgBox("Confirmer l'envoi du mail", vbYesNo) = vbNo Then Me.Message = "Envoi abandonné" Exit Sub End If ' sauvegarde le texte du mail et l'objet '-------------- ' Objet '------------- Feuil11.Range("Param_obj_mail") = Me.Objet '---------------------------------------------- ' texte du mail dans N cellules '---------------------------------------------- 'Raz du texte précédent Lig = Feuil11.Range("Param_text_mail").Row col = Feuil11.Range("Param_text_mail").Column Do Until Feuil11.Cells(Lig, col) = "" Feuil11.Cells(Lig, col) = "" Lig = Lig + 1 Loop ' nombre de cellules à valoriser NbCell = Len(Me.TexteMail) / 255 Lig = Feuil11.Range("Param_text_mail").Row col = Feuil11.Range("Param_text_mail").Column For i = 0 To NbCell Feuil11.Cells(Lig + i, col) = Mid(Me.TexteMail, 1 + (i * 255), 255) Next i '--------------------------------- ' piece jointe '----------------------- Feuil11.Range("Param_piece_jointe") = Me.Piece_jointe 'Sheets("Feuil11").Range("Param_serv_SMTP") = Me.Serveur_smtp If Me.Liste_Dest.ListCount = 0 Then Exit Sub Destinataires = "" For i = 0 To Me.Liste_Dest.ListCount - 1 Destinataires = Destinataires & Me.Liste_Dest.List(i, 1) & ";" Next i '================================================== ' Constitution du mail '================================================== ' LeMail = Me.TexteMail strHTML = "" strHTML = strHTML & "<HEAD>" strHTML = strHTML & "<BODY background='http://www.test.fr/images/fonds/fond-1.png' left top fixed no-repeat<BR>" strHTML = strHTML & "Bonjour & NomCli,<BR>" strHTML = strHTML & " <BR>" strHTML = Me.TexteMail strHTML = strHTML & " <BR>" strHTML = strHTML & "Vous souhaitant bonne reception, nous restons a votre disposition pour tous renseignements.<BR>" strHTML = strHTML & " <BR>" strHTML = strHTML & "<i>La lecture du fichier joint necessite la presence sur votre ordinateur du logiciel Adobe Acrobat Reader.</i><BR>" strHTML = strHTML & "<i>Si vous ne possedez pas ce logiciel cliquez sur : <A href='http://www.adobe.fr/products/acrobat/readstep.html'>www.adobe.fr/products/acrobat/readstep.html</A> pour le telecharger.</i><BR>" strHTML = strHTML & " <BR>" strHTML = strHTML & "Sinceres salutations.<BR>" strHTML = strHTML & "F. COCHIN<BR>" strHTML = strHTML & "<img src='http://www.test.fr/images/Encart_email.png'><BR>" strHTML = strHTML & "<center><img src='http://www.test.fr/images/icones/Draftsadres.gif'>TesT<BR>" strHTML = strHTML & "<center><img src='http://www.test.fr/images/icones/Draftstel.gif'>04.54.61.89.54<BR>" strHTML = strHTML & "<center><img src='http://www.test.fr/images/icones/Draftsport.gif'></A>06.07.13.32.62<BR>" strHTML = strHTML & "<center><img src='http://www.test.fr/images/icones/Draftsemail.gif'><A href='http://www.test.fr/'><i>www.test.fr</i></A></center><BR>" strHTML = strHTML & "</BODY>" strHTML = strHTML & "" '======================== ' Envoi avec CDO Message '======================== Dim iMsg As Object Dim iConf As Object ' Dim Flds As Variant Set iMsg = CreateObject("CDO.Message") Set iConf = CreateObject("CDO.Configuration") iConf.Load -1 ' CDO Source Defaults Set Flds = iConf.Fields With Flds .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _ = Me.Serveur_smtp ' = "Fill in your SMTP server here" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Update End With Dim tab_env() As String ReDim tab_env(Me.Liste_Dest.ListCount + 1) NbError = 0 For i = 0 To Me.Liste_Dest.ListCount - 1 On Error GoTo 0 'Resume Next Err.Clear With iMsg Set .Configuration = iConf .To = Me.Liste_Dest.List(i, 1) If i = 0 Then If Not IsNull(Me.Liste_Dest_copie.List(i, 1)) Then .CC = Me.Liste_Dest_copie.List(i, 1) End If If Not IsNull(Me.Liste_Dest_copie_cachee.List(i, 1)) Then .BCC = Me.Liste_Dest_copie_cachee.List(i, 1) End If End If .From = Me.From .Subject = Me.Objet .HTMLBody = strHTML ' .TextBody = LeMail If Me.Piece_jointe <> "" Then .AddAttachment Me.Piece_jointe End If Cetenvoi = .send ' .send End With If Err.Number <> 0 Then tab_env(i) = "KO" NbError = NbError + 1 Else tab_env(i) = "OK" End If Next i If NbError > 0 Then LeMsgError = NbError & " mail(s) ne sont pas partis : " & Chr(10) For i = 0 To Me.Liste_Dest.ListCount - 1 If tab_env(i) = "KO" Then LeMsgError = LeMsgError & Me.Liste_Dest.List(i, 1) & Chr(10) End If Next i Me.Message = LeMsgError Else 'MsgBox "les mails ont bien été envoyés" UserForm5.Show End If End Sub
Bonsoir Oliv- et au forum,
Je me suis inspirée d'une partie du code sinon le reste vient de moi. Je me souviens plus d’où j'avais trouvé celui-ci.
Avec du recul et ce que j'ai sur ce forum, j’aurais du mettre la source dans mon fichier. Désolé de ne pas pouvoir en dire plus.
j'ai refais des tests mais j'ai un problème icisouligné en jaune avec message erreur d'execution '-2147220978 (804020e)': le serveur a rejeté l'adresse de l'expéditeur...
Code : Sélectionner tout - Visualiser dans une fenêtre à part Cetenvoi = .send
Question :
Peut-on amélioré de façon à éviter les boutons <<-Tous, <-Retirer et Tous->> multiplié par 3 ?
Merci
Stephanie
c'est l'adresse cci je pense qui correspond à un nom de site web pas email.
Tu dois remettre ton on error resume next juste avant cette ligne
et renvoyer la description de l'erreur dans ton log.
bonsoir
le code viens de toi????
regarde dans ma signature tu en a un tout fait avec CDO
tu dois etre telepathe
il ne te reste plus qu'a ajouter ta liste de destinataire
au plaisir
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Salut Patrick,
C'est marrant j'étais hier soir justement en train d'essayer de lire ton fichier mailer..., interrompu par un pb de disque dur...
Bon il y a de la correction orthographique à faire !! Mise à part cela, tu ne gères pas non plus les erreurs sur .send
J'aime bien la version de Stéphanie, qui est plus de l'envoi de masse alors que le tien est unitaire.
le mien est bien que fonctionnel une base
j'ai retrouver ce code dans tout les modèles que j'ai pu trouver sur différent forums ça veut dire que correction orthographique ou pas il est relativement évolutif et fonctionnel et surtout adaptable
quand a l'envoie de masse comme je l'ai dit il n'y a plus qu' a adapter sa listbox
voili voilou
au plaisir
mes fichiers dans les contributions:
mail avec CDO en vba et mail avec CDO en vbs dans un HTA
survol des bouton dans userform
prendre un cliché d'un range
si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
et n'oublie pas de voter
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager