Boucle qui se stoppe sans explication

**JFV__** · 21/03/2017, 12h09

Bonjour,

J'ai une macro qui envoie des mails sous Outlook mais qui se stop sans que je sache pourquoi (sans message d'erreur)...

Dans une colonne C j'ai l'adresse de l'agent (X agents) dans la colonne D l'adresse du responsable (Y responsables). X et Y=3 dans l'exemple du fichier joint soit 3 mails à envoyer..
Dans cet exemple 1 seul mail s'affiche et la macro se stop sans message d'erreur.

Mes données étant confidentielles j'ai mis un exemple mais "dans la vraie vie" je peux avoir entre 50 à 500 mails à envoyer d'un coup et si la boucle se stop, difficile de s'assurer que tous les mails ont bien été envoyés...et même se les "taper" à la main un par un...pas top

Par exemple j'avais 72 lignes et l'envoi des mails se stoppait à la ligne 40...

Du coup quelqu'un peut-il me dire pourquoi cela ne marche pas? J'ai modifié à plusieurs reprises mon code mais cela ne marche pas.

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
Sub Lancer_le_Mailing()
 
Dim liste_Resp As Range
Dim infos As String
Dim infos2 As String
Dim infos3 As String
Dim RESP As String
Dim liste_Agent
 
Dernligne = Range("B" & Rows.Count).End(xlUp).Row
Range("A3").Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]="""","""",R[-1]C)"
    Range("A3").AutoFill Destination:=Range("A3:A" & Dernligne)
 
Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
 
 Range("A2:D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Mailing").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Mailing").Sort.SortFields.Add Key:=Range("C3:C" & Dernligne _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Mailing").Sort.SortFields.Add Key:=Range("B3:B" & Dernligne _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Mailing").Sort
        .SetRange Range("A2:D" & Dernligne)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
Range("Z:Z").Cells.ClearContents
Set liste_Agent = Range([c3], [c65536].End(xlUp))
[c:c].AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Range("Z2").Select
    ActiveCell.FormulaR1C1 = "Liste Adresse @mail Agent"
    Range("Z2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
liste_Agent.Copy ([Z3])
Set liste_Resp = Range([Z3], [Z65536].End(xlUp))
Columns("Z:Z").EntireColumn.AutoFit
 
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
 
For Each cell In liste_Resp.Cells
 
For Each cell2 In liste_Agent.Cells
If cell2 = cell Then
If InStr(1, RESP, cell2.Offset(, 1)) = 0 Then RESP = RESP & ";" & cell2.Offset(, 1)
infos = cell2.Offset(, -2) & " " & cell2.Offset(, -1) & infos
infos2 = cell2.Offset(, -2) & " " & cell2.Offset(, -1) & Chr(10) & infos2
infos3 = cell2.Offset(, 2)
End If
Next
 
infos = Left(infos, Len(infos))
infos2 = Left(infos2, Len(infos2))
 
Dim outapp As Object, outmail As Object
Dim dest As String
 
Set outapp = CreateObject("Outlook.Application")
outapp.Session.Logon
Set outmail = outapp.CreateItem(0)
 
With outmail
 
.Importance = 2
.SentOnBehalfOfName = "adresseX@mail.fr"
.To = cell
.cc = RESP
.Subject = "ObjetX" & " " & infos3
.HTMLBody = "<HTML><body><FONT COLOR=RED><b><u>Merci d'utiliser UNIQUEMENT la touche : REPONDRE A TOUS pour répondre à ce message</FONT></b></u><p><p>" _
& "Bonjour,<p><p>" _
& "Blablabla"
.Display
 
End With
 
infos = ""
infos2 = ""
infos3 = ""
RESP = ""
Next
 
End Sub

**unparia** · 21/03/2017, 12h22

Bonjour
Si ton titre avait résumé la difficulté (envoi d'emails en masse), tu aurais probablement trouvé ta réponse à la rubrique "discussions similaires" ci-dessous.
Et tu serais arrivé ainsi à ce lien (entre autres) :
https://www.developpez.net/forums/d1...voi-masse-vba/

Invité · 21/03/2017, 14h19

Bonjour,
dans ce genre de symptôme, je ne me casse pas à cherche midi à 14 heure! dans IE je tape le raccourcie clavier [Ctrl] + [F] puis je tape On Error et invariablement je trouve l'explication du manque d'information sur une éventuelle erreur!

**JFV__** · 21/03/2017, 14h44

Bonjour et merci à vous deux dysorthographie et unparia!

Je précise que je suis "en appui" aux services de ma boîte et que nous sommes obligés de passer par la voie officielle : Outlook (j'ai vu que l'utilisateur avait solutionné son problème en passant par gmail : option à écarter catégoriquement pour moi).

Je lance cette macro au travail alors tout ce qui est protocole il est vrai que cela ne m'est pas passé par la tête...La solution intermédiaire proposée, à savoir prévoir un temps d'attente (5 secondes par ex) avant l'envoi de chaque mail pour ne pas "encombrer" le serveur marche-t-elle réellement? Je vais faire un test mais je ne voudrais pas passer du temps inutilement.

**joe.levrai** · 21/03/2017, 14h48

Bonjour,

le premier truc qui me saute aux yeux, c'est qu'à chaque envoi, tu sors toute l'artillerie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim outapp As Object, outmail As Object
Dim dest As String
 
Set outapp = CreateObject("Outlook.Application")
outapp.Session.Logon

Autant crée l'instance outlook AVANT
et c'est seulement le CreateItem(0) qui reste dans la boucle

d'ailleurs, l'application Outlook est déjà lancée ou pas ? Car le Logon ne me semble pas nécessaire
Et pourquoi un SendOnBehalf ? C'est volontaire ou tu ne sais pas exactement ce que c'est ?

j'ai pas décortiqué plus en profondeur, les travaux sur objets actifs et le problème d'indentation demande plus de concentration que je n'en ai à l'instant présent

Invité · 21/03/2017, 14h51

quand tu auras viré ce vilain on error on pourra discuté!

**joe.levrai** · 21/03/2017, 14h54

tu parles de cette gestion d'erreur ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0

elle est pas trop moche à mon sens, même si on pourrait aisément s'en passer avec un simple test If .FilterMode Then .ShowAllData

**JFV__** · 21/03/2017, 16h37

Envoyé par joe.levrai

d'ailleurs, l'application Outlook est déjà lancée ou pas ? Car le Logon ne me semble pas nécessaire
Et pourquoi un SendOnBehalf ? C'est volontaire ou tu ne sais pas exactement ce que c'est ?

j'ai pas décortiqué plus en profondeur, les travaux sur objets actifs et le problème d'indentation demande plus de concentration que je n'en ai à l'instant présent

A la première question pour le Logon : cela dépend de l'utilisateur, j'ai voulu lever un max de contrainte pour l'utilisateur (qui n'est pas toujours le même,avec des connaissances en Excel souvent au niveau de la mer)

A la seconde, le SendOnBehalf est là pour choisir la boite mail à partir de laquelle on envoie le mail, dans mon cas le message diffère selon la boîte qui est choisie car le service en question possède 10 boites génériques rattachées à un même compte. Donc mis volontairement.

Envoyé par dysorthographie

quand tu auras viré ce vilain on error on pourra discuté!

Alors j'ai neutralisé le On Error et il ne se passe rien de plus...un seul mail envoyé au lieu de 3 dans l'exemple du fichier attaché et pas de message d'erreur;
Je ne sais plus précisément à quel moment je l'ai ajouté mais je l'ai mis car j'ai rencontré un cas particulier qui me mettait en erreur...je ne pense pas non plus que cela ait un impact sur le fonctionnement du code.

Une autre piste svp??

**pijaku** · 22/03/2017, 18h53

Bonjour,
Essaie d'inverser les lignes 39 & 40 du code montré dans ton premier message : filtrer d'abord la colonne C avant d'alimenter ta variable liste_agent.
En second, je te recommande de coder explicitement les propriétés de tes objets.
Ainsi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 If Cell = Cell2 Then

Mérite d'être remplacé par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 If Cell.Value = Cell2.Value Then

Sinon il peut aussi s'agir d'un souci dans tes données, mais ça seul toi peux le voir.

**clementmarcotte** · 23/03/2017, 04h03

Envoyé par JFV__

avec des connaissances en Excel souvent au niveau de la mer)

Moi, à ta place, je piloterais un parcours de formation en Excel.

**pijaku** · 23/03/2017, 09h33

Bon...
En reprenant ton code et les conseils de chacun ici, j'ai fait ce test.
Pourrais tu essayer avec ta feuille?

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
Option Explicit
 
Public Sub Test_Mailing()
Dim RngColZ As Range, RngColC As Range, liste_Resp As Range, liste_Agent As Range
Dim outapp As Object, outmail As Object
Dim dest As String, infos As String, infos2 As String, infos3 As String, RESP As String
Dim attente As Long
 
    attente = 10 'A ADAPTER. Ici temps d'attente = 10 secondes
    Set outapp = CreateObject("Outlook.Application")
    outapp.Session.Logon
    Range("Z:Z").Cells.ClearContents
 
    [c:c].AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Set liste_Agent = Range([c3], [c65536].End(xlUp)).SpecialCells(xlCellTypeVisible)
 
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
 
    liste_Agent.Copy ([Z3])
    Set liste_Resp = Range([Z3], [Z65536].End(xlUp))
 
    For Each RngColZ In liste_Resp.Cells
        For Each RngColC In liste_Agent.Cells
            If RngColC.Value = RngColZ.Value Then
                If InStr(1, RESP, RngColC.Offset(, 1).Value) = 0 Then RESP = RESP & ";" & RngColC.Offset(, 1).Value
                infos = RngColC.Offset(, -2).Value & " " & RngColC.Offset(, -1).Value & infos
                infos2 = RngColC.Offset(, -2).Value & " " & RngColC.Offset(, -1).Value & Chr(10) & infos2
                infos3 = RngColC.Offset(, 2).Value
            End If
        Next
 
        RESP = Right(RESP, Len(RESP) - 1)
 
        Set outmail = outapp.CreateItem(0)
        With outmail
            .Importance = 2
            .SentOnBehalfOfName = "adresseX@mail.fr"
            .To = RngColZ.Value
            .cc = RESP
            .Subject = "ObjetX" & " " & infos3
            .HTMLBody = "<HTML><body><FONT COLOR=RED><b><u>Merci d'utiliser UNIQUEMENT la touche : REPONDRE A TOUS pour répondre à ce message</FONT></b></u><p><p>" _
            & "Bonjour,<p><p>" _
            & "Blablabla"
            .Send '.Display
        End With
 
        infos = ""
        infos2 = ""
        infos3 = ""
        RESP = ""
        Set outmail = Nothing
        Application.Wait Time + TimeSerial(0, 0, attente)
        DoEvents 'surement inutile, mais ne fait pas de mal...
    Next
    Set outapp = Nothing
End Sub

**JFV__** · 23/03/2017, 13h40

J'ai testé et :

Pour ceux que ça intéresse, mon problème n'était pas dû au temps d'attente entre chaque mail envoyé car j'ai neutralisé le 'Application.Wait Time + TimeSerial(0, 0, attente) et tous mes mails partent bien (même si cela peut être utile pour ne pas "embouteiller le traffic", je le conserve au chaud on ne sait jamais).

Il y avait donc un problème dans les étapes de construction du code, à respecter, rien à voir avec mon serveur ou limite d'envoi de ma boîte. Donc tester ce code avant de vous lancer dans des opérations de changement de vos serveurs ou autres.

merci pijaku tu es un killer

**pijaku** · 23/03/2017, 14h01

Attention toutefois :

je peux avoir entre 50 à 500 mails à envoyer d'un coup

Ca risque de bloquer, donc je rejoinds mes amis d'ici en disant : renseigne toi auprès du DSI de ta boîte.
A Lire

Invité · 23/03/2017, 14h09

il ne faut pas oublier également qu'il peut y avoir un quota de Mo, donc penser par macro à vider la boîte d'envoi!

**JFV__** · 23/03/2017, 14h10

Ok ça marche!
J'ai testé sur 56 mails et c'est passé mais oui je vais me renseigner quand même.

Re! Après renseignement pas de limite du genre dans ma boite, mais pour les autres renseignez-vous ça ne coûte rien.

**pijaku** · 23/03/2017, 18h41

Ne crie pas victoire trop rapidement.
J'aimerais que tu nous fasses un retour sur 500 mails avec une estimation du temps que cela a pris; ceci dans le but d'aider tous les internautes tombant sur ce sujet...

**JFV__** · 24/03/2017, 11h16

Bonjour,

Effectivement tu dis vrai...après différentes tentatives mon problème demeure malgré la non limitation de mails envoyés par mon entreprise (d'ailleurs je fais "display" pour tester alors les mails n'étant pas envoyés cela ne touche pas à la limitation même s'il y en avait une, je pense...).
J'ai testé sans temps d'attente, avec temps d'attente de 1 seconde à 5 secondes...même résultat.
Si j'ai moins de 50 mails ça passe à tous les coups au delà c'est aléatoire..56 à envoyer la macro en génère bien 56 sur un cas, 53 sur 56 pour un autre cas...Je suis à court d'idée.

Modifier le paramètre serveur alors que je n'envoie pas les mails, je les génère seulement me semble inutile, enfin je ne sais pas.
Je vais tester un code qui envoie les mails par vague de 40 et vous tiens au courant.

Invité · 24/03/2017, 11h42

Bonjour,
il est normale que chaque entreprise et/ou hébergeur, se prémunisse des spams! je pense que le problème vient de la gestion des antispam! le contournement est sens doute possible en informant la chêne de commandement que telle boîte mail n'est pas
un spammeur!

dans ma boîte on utilise Gmail nous somme limé à 2000 par jours!

https://support.google.com/a/answer/166852?hl=fr

mais il faut envisager un serveur de mailing avec un compte chez un hébergeur qui va bien!

**JFV__** · 24/03/2017, 14h57

Oui c'est une éventualité à prendre en compte!
Mais moi en test je ne fais que générer les mails, je ne les envoie pas, du coup ça ne semble pas être un cas de spam sauf si Outlook bloque les mails dès qu'on commence à faire "Nouveau message électronique"...ça m'étonnerait quand même.

Je fini les tests en faisant 40 par 40 et pour l’instant ça passe avec 50 à 100 mails, je test les 500...

Mais ton lien est très intéressant : a lire!

Boucle qui se stoppe sans explication [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager