Discussion :

[rico63]

Bonjour à tous,

La macro ci-dessous me permet de trier des données, créer des fichiers Excel et d'envoyer ces fichiers à des destinataires différents si l'adresse mail existe.

Mon problème est le suivant : tous les mails sont crées mais tous (60% enfin ça dépend) ne sont pas envoyés (la fenêtre reste ouverte, il suffit ensuite pour moi d'appuyer sur envoyer mais cela ne correspond pas au fonctionnement que je souhaite).
Pourquoi ?
Il faudrait attendre que le mail soit envoyé avant de poursuivre le code après le SendKey je pense. Comment avoir cette information et comment gérer l'attente ?

Merci pour votre aide.

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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
Sub CreationFichierExcelFournisseurPlusMail()

'Début de la déclaration des variables
Dim objMaPlage As Range
Dim cell As Range
Dim colCollectionPass As Collection
Dim I As Long
Dim compteur, compteurmail, compteurfichier, compteurtotal As Integer
Dim LastRow, LastRow2 As Long
 
    Dim FichierSource As Workbook
    Dim FichierDestination As Workbook
    Dim Temp As String
    Dim nom As String
    Dim Fichier As String

    Dim ol As New Outlook.Application
    Dim olmail As MailItem
    Dim corps As String

Dim MaRech As Range
Dim Fournisseur As String
Dim MailFournisseur, MailFournisseurCC As String

Dim Reponse As Long

'Fin de la déclaration des variables
'--------------------------------------------------------------------------
 
'Début des actions et demande de confirmation avant traitement des informations
Reponse = MsgBox("Voulez vous continuer la création des fichiers et l'envoi par e-mail ?", vbQuestion + vbYesNo, "Demande de confirmation")
If Reponse = vbYes Then


'Début de l'initialisation des variables
    'Set ol = New Outlook.Application
    'Set olmail = ol.CreateItem(olMailItem)
compteurmail = 0
compteurfichier = 0
compteurtotal = 0

Set objMaPlage = Range(Range("B" & Rows.Count).End(xlUp), Cells(5, 2)).SpecialCells(xlCellTypeVisible)
objMaPlage.Select 'inutile, pour visualisation seulement
Set colCollectionPass = New Collection
 On Error Resume Next
For Each cell In objMaPlage
   colCollectionPass.Add cell, CStr(cell)
Next cell
For I = 2 To colCollectionPass.Count 'on élimine le titre en 1...ce qui serait plus lour avec un for each
   'Debug.Print colCollectionPass(I) 'résultat voulu à employer sous la forme désirée.
   'MsgBox (colCollectionPass(I))
Next I
 
 
'Début de la boucle pour faire varier le filtre
For compteur = 1 To colCollectionPass.Count

    Set ol = New Outlook.Application 'Test evi
    Set olmail = ol.CreateItem(olMailItem) 'Test evi

Selection.AutoFilter Field:=2, Criteria1:=colCollectionPass(compteur)

    Sheets("Sheet2").Select
    LastRow2 = Cells(Rows.Count, "A").End(xlUp).Row
    Rows("1:" & LastRow).Select
    Selection.Delete Shift:=xlUp
    
    Sheets("Les données SAP").Select
    LastRow = Cells(Rows.Count, "B").End(xlUp).Row

    Range("B5:X" & LastRow).Select
    Selection.Copy
    
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    Columns("A:M").Select
    Columns("A:M").EntireColumn.AutoFit
    
    Range("A1").Select
    
    

    Set FichierSource = ActiveWorkbook
    ActiveSheet.Copy                            'Copie de la totalité de l'onglet actif dans le fichier source
    
    Set FichierDestination = ActiveWorkbook
        
'Début des opérations permettant la préparation du fichier excel temporaire avant envois par e-mail
    nom = Range("A2")
    Temp = ThisWorkbook.Path & Application.PathSeparator & "ZEvi Fichier Excel" & Application.PathSeparator & nom & ".xls"             'Attribution du nom du fichier temporaire et mémorisation du chemin complet de ce dernier
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    FichierDestination.SaveAs Temp                                                              'Sauvegarde (création) du fichier temporaire dans le même répertoire que le fichier d'origine
    Fichier = FichierDestination.Path & Application.PathSeparator & FichierDestination.Name     '
    FichierDestination.Close                                                                    'Fermeture du fichier précédemment sauvegardé
    Application.DisplayAlerts = True
'Fin des opérations permettant la préparation du fichier excel temporaire avant envois par e-mail
'--------------------------------------------------------------------------
    

'Test si il existe une addresse e-mail afin d'envoyer ou pas un e-mail
MailFournisseur = ""
MailFournisseurCC = ""

Fournisseur = nom
Set MaRech = Sheets("Mail").Range("A2:A65000").Find(Fournisseur, LookIn:=xlValues) 'Adapter le nom de la feuille qui contient le tableau
    If Not MaRech Is Nothing Then   'Si MaRech n'est pas rien (donc référence trouvée)
        MailFournisseur = MaRech.Offset(0, 1)  'Affectation à la variable du contenu de la cellule de droite de celle qui contient la référence
        MailFournisseurCC = MaRech.Offset(0, 2)
    Else
        MailFournisseur = ""
        MailFournisseurCC = ""
    'MsgBox "La référence n'est pas connue" 'Boite de dialogue indiquant que la référence n'existe pas
    End If

If MailFournisseur <> "" Then
'Début de l'envois du mail
    'Ecrire ici l'ensemble du texte qui apparaitra dans le mail, vbNewLine permet de mettre en forme le texte et d'aller à la ligne
    compteurmail = compteurmail + 1
    corps = "Bonjour," & vbNewLine & _
            " " & vbNewLine & _
            "Vous trouverez ci-joint un fichier correspondant à nos commandes non livrées ou partiellement livrées." & vbNewLine & _
            "Je vous demanderai de bien vouloir compléter ce tableau en indiquant les dates cohérentes de livraison pour chaque article de chaque commande." & vbNewLine & _
            "D'avance, merci pour votre collaboration," & vbNewLine & _
            "Vous en souhaitant bonne réception," & vbNewLine & _
            " " & vbNewLine & _
            "Cordialement," & vbNewLine & _
            " " & vbNewLine & _
            " " & vbNewLine & _
            " ************************************** " & vbNewLine & _
            "Hello," & vbNewLine & _
            " " & vbNewLine & _
            "Please find enclosed a file with all the open purchase orders, still to be delivered or partially delivered." & vbNewLine & _
            " " & vbNewLine & _
            "Could you please send it back to me with updating the delivery date?" & vbNewLine & _
            " " & vbNewLine & _
            "Wishing getting your reply soon." & vbNewLine & _
            "Thanks a lot," & vbNewLine & _
            " " & vbNewLine & _
            "Best regards," & vbNewLine & _
            " " & vbNewLine

    With olmail
       .To = MailFournisseur    'Adresse mail du destinataire
       '.CC = MailFournisseurCC  'Personne à mettre en copie du mail
       .Subject = "Commandes non livrées ou partiellement livrées ..."            'Titre du mail
       .Body = corps                    'Descriptif de l'envoi du mail
       .Attachments.Add Fichier         'Insertion du fichier en pièce jointe, la variable Fichier contenant le chemin complet du fichier à joindre qui dans le cas présent est "Fichier Temporaire.xls"
       .ReturnReceipt                  'Pour avoir un accusé de reception
       .Display                         'Permet l'affichage du mail et évite ensuite d'avoir le message de sécurité lors d'envois d'un e-mail à partir d'excel
    End With
    
       SendKeys "^{ENTER}"              'Envoi du mail par les touches Ctrl + Enter "^{Enter}"

Application.ScreenUpdating = True
  
Kill Fichier                            'Effacement du Fichier Temporaire créé lors de cette macro
'Fin de l'envois du mail
'--------------------------------------------------------------------------
Else
compteurfichier = compteurfichier + 1
End If

Application.ScreenUpdating = True

    Sheets("Les données SAP").Select
    
    Range("B5").Select
    Application.CutCopyMode = False

Next compteur
'Fin des opérations pour lister les noms des fournisseurs sans doublons
'--------------------------------------------------------------------------

Selection.AutoFilter Field:=2

Set objMaPlage = Nothing 'pas obligatoire, mais bonne habitude.
Set colCollectionPass = Nothing


Else
End If
'Fin des actions et demande de confirmation avant traitement des informations
'--------------------------------------------------------------------------
compteurtotal = compteurmail + compteurfichier
MsgBox (compteurmail & "   E-mail envoyés" & Chr(10) & _
        compteurfichier & "   Fichiers Excel créés" & Chr(10) & _
        "--------------------------------" & Chr(10) & _
        "Soit : " & compteurtotal & "  Fournisseurs traités.")
End Sub

Bonsoir,
Pour info, j'ai également fais des essais avec :
SendKeys "^{ENTER}" , true afin d'attendre l'action
Sendkeys "%V"

Mais cela ne change pas mon problème ...

[BenjGe]

vous pouvez essayer un

Code :

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

application.wait 1000

avant le sendkeys, pour la valeur je ne m'en rappelle plus mais ça doit correspondre à 1000 ms
mais je pense que pour l'envoi de mail propre il vaut mieux utliser la bibliothèque CDO.

[rico63]

Bonsoir Benjîle,
Je viens de tester ta proposition mais je suis au regret de t'annoncer que cela ne fonctionne pas. Le problème reste le même.

J'ai déjà essayé d'utilisé le CDO mais je n'y arrive pas.

Merci pour ton aide.

Si vous avez d'autres propositions je suis toujours preneur.

[Godzestla]

Bonjour,

au cas ou, ile existe DOEVENTS pour attendre la complétion d'un évènement extérieur.

Bonne journée.

[rico63]

Bonjour,
J'ai essayé la proposition DoEvents mais le problème reste le même.
Je dois pas l'utiliser comme il faut ...
Merci tout de même.

[rico63]

Bonjour à tous,
Je viens de trouver la solution à mon problème.
j'ai remplacé "SendKeys "^{ENTER}"" par le code ci-dessous.

Code :

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

1
2
3
AppActivate Objet_Mail & "TitreDuMessage - Message", 0   ' Active Outlook
    Application.Wait (Now + TimeValue("0:00:01"))
    SendKeys "%v", True  ' Envoi du message

Merci à tous de m'avoir fourni les pistes ...
Bonne journée et @+.