envoi avec CDO limité

Le
Pascal
bonsoir
l'erreur suivante :
(Erreur d'exécution, le serveur à rejeté l'adresse de l'expéditeur, la
réponse du serveur était (un numéro) Too many messages for this session)

est provoquée chaque fois que je tente d'envoyer plus de 10 mail avec CDO.
9 passent 10 et plus ne passent pas, il y a une limitation?
KKchose à rajouter dans cette partie ?
With iMsg
Set .Configuration = iConf
.To = CdoAdresseMail
.CC = ""
.BCC = ""
.From = "Expediteur@moi.com"
.Subject = "Mon message"
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = strbody
.Send
End With

j'ai tenté de freiner un peu le système en insérant un DOEVENTS à chaque
passage de la boucle mais en vain! si kkun a une idée?
merci d'avance
Pascal
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Christophe Mathon
Le #16388781
Bonjour Pascal,

Le message d'erreur "Too many messages for this session" est envoyé par ton
serveur de messagerie.
Il faut que tu ferme la session et que tu rouvre une nouvelle. C'est une
règle qui est utilisée sur le serveur même et que tu ne peux pas changer
(pour éviter le spamming je pense).

Si tu me donne un peut plus de code, je peux te dire quoi changer.

--
Regards
Christophe Mathon
while(!(succeed=try()));

"Pascal" ,com> wrote in message
news:
bonsoir
l'erreur suivante :
(Erreur d'exécution, le serveur à rejeté l'adresse de l'expéditeur, la
réponse du serveur était (un numéro...) Too many messages for this
session)

est provoquée chaque fois que je tente d'envoyer plus de 10 mail avec CDO.
9 passent 10 et plus ne passent pas, il y a une limitation?
KKchose à rajouter dans cette partie ?
With iMsg
Set .Configuration = iConf
.To = CdoAdresseMail
.CC = ""
.BCC = ""
.From = ""
.Subject = "Mon message"
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = strbody
.Send
End With

j'ai tenté de freiner un peu le système en insérant un DOEVENTS à chaque
passage de la boucle mais en vain! si kkun a une idée?
merci d'avance
Pascal





Pascal
Le #16462951
hello christophe,
sorry je veins juste de voir que tu avais répondu à mon message, j'avais
perdu espoir au bout de quelques jours
j'ai finalement trouvé seul et comme tu dit : règle du seveur pour le spam
je relance donc à chaque fois une session
merci pour ton aide
Pascal


"Christophe Mathon" de discussion :
Bonjour Pascal,

Le message d'erreur "Too many messages for this session" est envoyé par
ton
serveur de messagerie.
Il faut que tu ferme la session et que tu rouvre une nouvelle. C'est une
règle qui est utilisée sur le serveur même et que tu ne peux pas changer
(pour éviter le spamming je pense).

Si tu me donne un peut plus de code, je peux te dire quoi changer.

--
Regards
Christophe Mathon
while(!(succeed=try()));

"Pascal" ,com> wrote in message
news:
bonsoir
l'erreur suivante :
(Erreur d'exécution, le serveur à rejeté l'adresse de l'expéditeur, la
réponse du serveur était (un numéro...) Too many messages for this
session)

est provoquée chaque fois que je tente d'envoyer plus de 10 mail avec
CDO.
9 passent 10 et plus ne passent pas, il y a une limitation?
KKchose à rajouter dans cette partie ?
With iMsg
Set .Configuration = iConf
.To = CdoAdresseMail
.CC = ""
.BCC = ""
.From = ""
.Subject = "Mon message"
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = strbody
.Send
End With

j'ai tenté de freiner un peu le système en insérant un DOEVENTS à chaque
passage de la boucle mais en vain! si kkun a une idée?
merci d'avance
Pascal








michdenis
Le #16495131
Tu peux utiliser ceci :

P.S- Attention aux lignes qui pourraient être coupé
par le service de messagerie.

'------------------------------------
Sub test()

'Requiert la référence suivante :
'Microsoft CDO For Windows 2000 Librairy

Dim ObjMail As New CDO.Message
Dim ServeurSMTP As String, Texte As String
Dim Suget As String, Fichier As String
Dim Destinataire As String, Expediteur As String
Dim FichiersJoints As String
Dim AutresDestinataires As String

'*********** à Définir******************
ServeurSMTP = "smtp.... ' ...à définir"
Sujet = "La raison du message ?"
Texte = "Texte du Message ?"
'Si plusieurs fichiers : séparer par un point-virgule
FichiersJoints = "" ' si requis
Destinataire = ""
Expediteur = ""
'Si plusieurs adresses : séparer par un point-virgule"
AutresDestinataires = ""
'****************************************
With ObjMail
.To = Destinataire ' ""
.From = Expediteur
.CC = AutresDestinataires
.Subject = Sujet
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = Texte
If Dir(Fichier) <> "" Then
.AddAttachment FichiersJoints
End If
With .Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") ServeurSMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
.Update
End With
.Send
End With

End Sub
'------------------------------------









"Pascal" ,com> a écrit dans le message de news:

bonsoir
l'erreur suivante :
(Erreur d'exécution, le serveur à rejeté l'adresse de l'expéditeur, la
réponse du serveur était (un numéro...) Too many messages for this session)

est provoquée chaque fois que je tente d'envoyer plus de 10 mail avec CDO.
9 passent 10 et plus ne passent pas, il y a une limitation?
KKchose à rajouter dans cette partie ?
With iMsg
Set .Configuration = iConf
.To = CdoAdresseMail
.CC = ""
.BCC = ""
.From = ""
.Subject = "Mon message"
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = strbody
.Send
End With

j'ai tenté de freiner un peu le système en insérant un DOEVENTS à chaque
passage de la boucle mais en vain! si kkun a une idée?
merci d'avance
Pascal
Pascal
Le #16495781
merci MichDenis,
j'avais déjà opté pour cette solution
cordialement
Pascal

"michdenis" discussion : OoRGU#H#
Tu peux utiliser ceci :

P.S- Attention aux lignes qui pourraient être coupé
par le service de messagerie.

'------------------------------------
Sub test()

'Requiert la référence suivante :
'Microsoft CDO For Windows 2000 Librairy

Dim ObjMail As New CDO.Message
Dim ServeurSMTP As String, Texte As String
Dim Suget As String, Fichier As String
Dim Destinataire As String, Expediteur As String
Dim FichiersJoints As String
Dim AutresDestinataires As String

'*********** à Définir******************
ServeurSMTP = "smtp.... ' ...à définir"
Sujet = "La raison du message ?"
Texte = "Texte du Message ?"
'Si plusieurs fichiers : séparer par un point-virgule
FichiersJoints = "" ' si requis
Destinataire = ""
Expediteur = ""
'Si plusieurs adresses : séparer par un point-virgule"
AutresDestinataires = ""
'****************************************
With ObjMail
.To = Destinataire ' ""
.From = Expediteur
.CC = AutresDestinataires
.Subject = Sujet
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = Texte
If Dir(Fichier) <> "" Then
.AddAttachment FichiersJoints
End If
With .Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") > 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")
> ServeurSMTP

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
.Update
End With
.Send
End With

End Sub
'------------------------------------









"Pascal" ,com> a écrit dans le message de news:

bonsoir
l'erreur suivante :
(Erreur d'exécution, le serveur à rejeté l'adresse de l'expéditeur, la
réponse du serveur était (un numéro...) Too many messages for this
session)

est provoquée chaque fois que je tente d'envoyer plus de 10 mail avec CDO.
9 passent 10 et plus ne passent pas, il y a une limitation?
KKchose à rajouter dans cette partie ?
With iMsg
Set .Configuration = iConf
.To = CdoAdresseMail
.CC = ""
.BCC = ""
.From = ""
.Subject = "Mon message"
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = strbody
.Send
End With

j'ai tenté de freiner un peu le système en insérant un DOEVENTS à chaque
passage de la boucle mais en vain! si kkun a une idée?
merci d'avance
Pascal





michdenis
Le #16495931
La proposition faire bien qu'elle resemble à ce que tu utilisais
est différente !

Tu écrivais sur ce fil :

| j'ai finalement trouvé seul et comme tu dit : règle du seveur pour le spam
| je relance donc à chaque fois une session

As-tu testé la proposition soumise ? Dois-tu continuer à relancer une
nouvelle session ?






"michdenis" OoRGU%23H%
Tu peux utiliser ceci :

P.S- Attention aux lignes qui pourraient être coupé
par le service de messagerie.

'------------------------------------
Sub test()

'Requiert la référence suivante :
'Microsoft CDO For Windows 2000 Librairy

Dim ObjMail As New CDO.Message
Dim ServeurSMTP As String, Texte As String
Dim Suget As String, Fichier As String
Dim Destinataire As String, Expediteur As String
Dim FichiersJoints As String
Dim AutresDestinataires As String

'*********** à Définir******************
ServeurSMTP = "smtp.... ' ...à définir"
Sujet = "La raison du message ?"
Texte = "Texte du Message ?"
'Si plusieurs fichiers : séparer par un point-virgule
FichiersJoints = "" ' si requis
Destinataire = ""
Expediteur = ""
'Si plusieurs adresses : séparer par un point-virgule"
AutresDestinataires = ""
'****************************************
With ObjMail
.To = Destinataire ' ""
.From = Expediteur
.CC = AutresDestinataires
.Subject = Sujet
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = Texte
If Dir(Fichier) <> "" Then
.AddAttachment FichiersJoints
End If
With .Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") ServeurSMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
.Update
End With
.Send
End With

End Sub
'------------------------------------









"Pascal" ,com> a écrit dans le message de news:

bonsoir
l'erreur suivante :
(Erreur d'exécution, le serveur à rejeté l'adresse de l'expéditeur, la
réponse du serveur était (un numéro...) Too many messages for this session)

est provoquée chaque fois que je tente d'envoyer plus de 10 mail avec CDO.
9 passent 10 et plus ne passent pas, il y a une limitation?
KKchose à rajouter dans cette partie ?
With iMsg
Set .Configuration = iConf
.To = CdoAdresseMail
.CC = ""
.BCC = ""
.From = ""
.Subject = "Mon message"
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = strbody
.Send
End With

j'ai tenté de freiner un peu le système en insérant un DOEVENTS à chaque
passage de la boucle mais en vain! si kkun a une idée?
merci d'avance
Pascal
Pascal
Le #16499681
hello MichelµDenis,
non je n'ai pas testé ta proposition car elle ressemble beaucoup à la mienne
je remarque le .update chez toi
ou alors je n'ai pas saisi la subtilité du code
voici ce que j'avais trouvé et qui finalement fonctionne

************************************************************
Dim iMsg As Object
Dim iConf As Object
Dim strBody As String
Dim Flds As Variant
Dim CdoAdresseMail As String
Dim cpt As Integer

for cpt = 3 to maxmembre

On Error GoTo ErreurMail

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source par défaut
Set Flds = iConf.Fields
With Flds 'configuration serveurs
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")
= 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")
= "relay.skynet.be"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
.Update
End With

'******Routine*****************
CdoAdresseMail = "Adresse Destinataire récupérée dans cellule"

'prépare le corps du message en récupérant les informations de la feuille
With Feuil5

strBody = le message est récupéré dans la feuille

End With

With iMsg
Set .Configuration = iConf
.To = CdoAdresseMail
.CC = ""
.BCC = ""
.From = "Expediteur"
.Subject = "Votre cotisation"
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = strBody
.Send
End With
next cpt

Exit Sub

ErreurMail:
Dim rep As String
rep = MsgBox("une erreur s'est produite lors de l'envoi" & vbCrLf & _
"Vérifiez votre connection ou" & vbCrLf & _
"l'adresse Mail du destinataire", vbCritical, "Impossible
d'envoyer")
Err.Clear

End Sub
************************************************************

"michdenis" discussion : uLlCkxI#
La proposition faire bien qu'elle resemble à ce que tu utilisais
est différente !

Tu écrivais sur ce fil :

| j'ai finalement trouvé seul et comme tu dit : règle du seveur pour le
spam
| je relance donc à chaque fois une session

As-tu testé la proposition soumise ? Dois-tu continuer à relancer une
nouvelle session ?






"michdenis" OoRGU%23H%
Tu peux utiliser ceci :

P.S- Attention aux lignes qui pourraient être coupé
par le service de messagerie.

'------------------------------------
Sub test()

'Requiert la référence suivante :
'Microsoft CDO For Windows 2000 Librairy

Dim ObjMail As New CDO.Message
Dim ServeurSMTP As String, Texte As String
Dim Suget As String, Fichier As String
Dim Destinataire As String, Expediteur As String
Dim FichiersJoints As String
Dim AutresDestinataires As String

'*********** à Définir******************
ServeurSMTP = "smtp.... ' ...à définir"
Sujet = "La raison du message ?"
Texte = "Texte du Message ?"
'Si plusieurs fichiers : séparer par un point-virgule
FichiersJoints = "" ' si requis
Destinataire = ""
Expediteur = ""
'Si plusieurs adresses : séparer par un point-virgule"
AutresDestinataires = ""
'****************************************
With ObjMail
.To = Destinataire ' ""
.From = Expediteur
.CC = AutresDestinataires
.Subject = Sujet
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = Texte
If Dir(Fichier) <> "" Then
.AddAttachment FichiersJoints
End If
With .Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") > 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")
> ServeurSMTP

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
.Update
End With
.Send
End With

End Sub
'------------------------------------









"Pascal" ,com> a écrit dans le message de news:

bonsoir
l'erreur suivante :
(Erreur d'exécution, le serveur à rejeté l'adresse de l'expéditeur, la
réponse du serveur était (un numéro...) Too many messages for this
session)

est provoquée chaque fois que je tente d'envoyer plus de 10 mail avec CDO.
9 passent 10 et plus ne passent pas, il y a une limitation?
KKchose à rajouter dans cette partie ?
With iMsg
Set .Configuration = iConf
.To = CdoAdresseMail
.CC = ""
.BCC = ""
.From = ""
.Subject = "Mon message"
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = strbody
.Send
End With

j'ai tenté de freiner un peu le système en insérant un DOEVENTS à chaque
passage de la boucle mais en vain! si kkun a une idée?
merci d'avance
Pascal





michdenis
Le #16499791
| car elle ressemble beaucoup à la mienne

La différence principale : avec la mienne je ne crois
pas que tu aies besoin d'une boucle pour envoyer tes
courriels. Tu peux simplement regrouper tes adresses
séparées pas des point-virgule, il en va de même pour
les fichiers joints au besoin.

ça va, je n'insiste pas !



"Pascal" ,com> a écrit dans le message de news:
%23rDXjBM%
hello MichelµDenis,
non je n'ai pas testé ta proposition car elle ressemble beaucoup à la mienne
je remarque le .update chez toi
ou alors je n'ai pas saisi la subtilité du code
voici ce que j'avais trouvé et qui finalement fonctionne

************************************************************
Dim iMsg As Object
Dim iConf As Object
Dim strBody As String
Dim Flds As Variant
Dim CdoAdresseMail As String
Dim cpt As Integer

for cpt = 3 to maxmembre

On Error GoTo ErreurMail

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source par défaut
Set Flds = iConf.Fields
With Flds 'configuration serveurs
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")
= 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")
= "relay.skynet.be"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
.Update
End With

'******Routine*****************
CdoAdresseMail = "Adresse Destinataire récupérée dans cellule"

'prépare le corps du message en récupérant les informations de la feuille
With Feuil5

strBody = le message est récupéré dans la feuille

End With

With iMsg
Set .Configuration = iConf
.To = CdoAdresseMail
.CC = ""
.BCC = ""
.From = "Expediteur"
.Subject = "Votre cotisation"
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = strBody
.Send
End With
next cpt

Exit Sub

ErreurMail:
Dim rep As String
rep = MsgBox("une erreur s'est produite lors de l'envoi" & vbCrLf & _
"Vérifiez votre connection ou" & vbCrLf & _
"l'adresse Mail du destinataire", vbCritical, "Impossible
d'envoyer")
Err.Clear

End Sub
************************************************************

"michdenis" discussion : uLlCkxI#
La proposition faire bien qu'elle resemble à ce que tu utilisais
est différente !

Tu écrivais sur ce fil :

| j'ai finalement trouvé seul et comme tu dit : règle du seveur pour le
spam
| je relance donc à chaque fois une session

As-tu testé la proposition soumise ? Dois-tu continuer à relancer une
nouvelle session ?






"michdenis" OoRGU%23H%
Tu peux utiliser ceci :

P.S- Attention aux lignes qui pourraient être coupé
par le service de messagerie.

'------------------------------------
Sub test()

'Requiert la référence suivante :
'Microsoft CDO For Windows 2000 Librairy

Dim ObjMail As New CDO.Message
Dim ServeurSMTP As String, Texte As String
Dim Suget As String, Fichier As String
Dim Destinataire As String, Expediteur As String
Dim FichiersJoints As String
Dim AutresDestinataires As String

'*********** à Définir******************
ServeurSMTP = "smtp.... ' ...à définir"
Sujet = "La raison du message ?"
Texte = "Texte du Message ?"
'Si plusieurs fichiers : séparer par un point-virgule
FichiersJoints = "" ' si requis
Destinataire = ""
Expediteur = ""
'Si plusieurs adresses : séparer par un point-virgule"
AutresDestinataires = ""
'****************************************
With ObjMail
.To = Destinataire ' ""
.From = Expediteur
.CC = AutresDestinataires
.Subject = Sujet
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = Texte
If Dir(Fichier) <> "" Then
.AddAttachment FichiersJoints
End If
With .Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") > 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")
> ServeurSMTP

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
.Update
End With
.Send
End With

End Sub
'------------------------------------









"Pascal" ,com> a écrit dans le message de news:

bonsoir
l'erreur suivante :
(Erreur d'exécution, le serveur à rejeté l'adresse de l'expéditeur, la
réponse du serveur était (un numéro...) Too many messages for this
session)

est provoquée chaque fois que je tente d'envoyer plus de 10 mail avec CDO.
9 passent 10 et plus ne passent pas, il y a une limitation?
KKchose à rajouter dans cette partie ?
With iMsg
Set .Configuration = iConf
.To = CdoAdresseMail
.CC = ""
.BCC = ""
.From = ""
.Subject = "Mon message"
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = strbody
.Send
End With

j'ai tenté de freiner un peu le système en insérant un DOEVENTS à chaque
passage de la boucle mais en vain! si kkun a une idée?
merci d'avance
Pascal





Pascal
Le #16501821
hello,
j'ai testé avec ma solution si peux également envoyé plusieurs mails séparé
par un point virgule
seulement cette solution ne me satisfait car chaque mail est propre à la
personne et avec cette façon le destinataire voit apparaître le nom de
toutes les personnes a qui ce courriel à été envoyé
La boucle dans mon cas est presque obligatoire car un mail n'est envoyé que
si certaine conditions sont remplies et ce pour un fichier de 500 personnes.
Merci pour tes conseils, qui m'ont bien aidé à progresser, toujours précieux
et que j'apprécie crois-le
cordialement

Pascal


"michdenis" discussion : uZY4nPM#
| car elle ressemble beaucoup à la mienne

La différence principale : avec la mienne je ne crois
pas que tu aies besoin d'une boucle pour envoyer tes
courriels. Tu peux simplement regrouper tes adresses
séparées pas des point-virgule, il en va de même pour
les fichiers joints au besoin.

ça va, je n'insiste pas !



"Pascal" ,com> a écrit dans le message de news:
%23rDXjBM%
hello MichelµDenis,
non je n'ai pas testé ta proposition car elle ressemble beaucoup à la
mienne
je remarque le .update chez toi
ou alors je n'ai pas saisi la subtilité du code
voici ce que j'avais trouvé et qui finalement fonctionne

************************************************************
Dim iMsg As Object
Dim iConf As Object
Dim strBody As String
Dim Flds As Variant
Dim CdoAdresseMail As String
Dim cpt As Integer

for cpt = 3 to maxmembre

On Error GoTo ErreurMail

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source par défaut
Set Flds = iConf.Fields
With Flds 'configuration serveurs

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")
= 2

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")
= "relay.skynet.be"

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
.Update
End With

'******Routine*****************
CdoAdresseMail = "Adresse Destinataire récupérée dans cellule"

'prépare le corps du message en récupérant les informations de la feuille
With Feuil5

strBody = le message est récupéré dans la feuille

End With

With iMsg
Set .Configuration = iConf
.To = CdoAdresseMail
.CC = ""
.BCC = ""
.From = "Expediteur"
.Subject = "Votre cotisation"
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = strBody
.Send
End With
next cpt

Exit Sub

ErreurMail:
Dim rep As String
rep = MsgBox("une erreur s'est produite lors de l'envoi" & vbCrLf & _
"Vérifiez votre connection ou" & vbCrLf & _
"l'adresse Mail du destinataire", vbCritical, "Impossible
d'envoyer")
Err.Clear

End Sub
************************************************************

"michdenis" discussion : uLlCkxI#
La proposition faire bien qu'elle resemble à ce que tu utilisais
est différente !

Tu écrivais sur ce fil :

| j'ai finalement trouvé seul et comme tu dit : règle du seveur pour le
spam
| je relance donc à chaque fois une session

As-tu testé la proposition soumise ? Dois-tu continuer à relancer une
nouvelle session ?






"michdenis" OoRGU%23H%
Tu peux utiliser ceci :

P.S- Attention aux lignes qui pourraient être coupé
par le service de messagerie.

'------------------------------------
Sub test()

'Requiert la référence suivante :
'Microsoft CDO For Windows 2000 Librairy

Dim ObjMail As New CDO.Message
Dim ServeurSMTP As String, Texte As String
Dim Suget As String, Fichier As String
Dim Destinataire As String, Expediteur As String
Dim FichiersJoints As String
Dim AutresDestinataires As String

'*********** à Définir******************
ServeurSMTP = "smtp.... ' ...à définir"
Sujet = "La raison du message ?"
Texte = "Texte du Message ?"
'Si plusieurs fichiers : séparer par un point-virgule
FichiersJoints = "" ' si requis
Destinataire = ""
Expediteur = ""
'Si plusieurs adresses : séparer par un point-virgule"
AutresDestinataires = ""
'****************************************
With ObjMail
.To = Destinataire ' ""
.From = Expediteur
.CC = AutresDestinataires
.Subject = Sujet
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = Texte
If Dir(Fichier) <> "" Then
.AddAttachment FichiersJoints
End If
With .Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")
>> 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")
>> ServeurSMTP

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25
.Update
End With
.Send
End With

End Sub
'------------------------------------









"Pascal" ,com> a écrit dans le message de news:

bonsoir
l'erreur suivante :
(Erreur d'exécution, le serveur à rejeté l'adresse de l'expéditeur, la
réponse du serveur était (un numéro...) Too many messages for this
session)

est provoquée chaque fois que je tente d'envoyer plus de 10 mail avec
CDO.
9 passent 10 et plus ne passent pas, il y a une limitation?
KKchose à rajouter dans cette partie ?
With iMsg
Set .Configuration = iConf
.To = CdoAdresseMail
.CC = ""
.BCC = ""
.From = ""
.Subject = "Mon message"
.MimeFormatted = True
.GetStream.Charset = cdoISO_8859_15
.BodyPart.Charset = cdoISO_8859_15
.BodyPart.ContentTransferEncoding = "base64"
.TextBody = strbody
.Send
End With

j'ai tenté de freiner un peu le système en insérant un DOEVENTS à chaque
passage de la boucle mais en vain! si kkun a une idée?
merci d'avance
Pascal








Publicité
Poster une réponse
Anonyme