BUG PONCTUEL : enregistrer un mail envoyé depuis Outlook via Excel

**altaar** · 11/01/2017, 19h17

Bonjour,

Depuis Excel, j'envoie un mail via Outlook. Nous l'appelerons le MAILEXCEL. Le MAILEXCEL est envoyé en automatique, via la commande ".send". Aucun problème, ça fonctionne. Voici le code utilisé :

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
Private Sub CommandButton1_Click()
'initialisation
lgn = [FTlgn]
Dim corps, sujet  As String
Dim oOutlook As Outlook.Application
Dim EmailMsg As Outlook.MailItem
 
Set oOutlook = CreateObject("Outlook.Application")
Set EmailMsg = oOutlook.CreateItem(olMailItem)
With EmailMsg
    .To = Feuil1.Cells(lgn, [VALadressemail].Column)
    sujet = "Rendez-vous " & Feuil1.Cells(lgn, [VALdossier].Column)
    .Subject = sujet
    .BodyFormat = olFormatHTML
    corps = "<html><body>Bonjour,<br><br>" & _
    "Je vous remercie de me confirmer ce rendez-vous.</span>"
    .GetInspector.CommandBars.Item("Insert").Controls("Signature").Controls(1).Execute
    .HTMLBody = corps & EmailMsg.HTMLBody
    .Send
End With
 
Call save_emailsent(sujetdumail, cheminsauvegarde, nomsouhaitédufichiermail)
 
End Sub

Comme présenté dans le code ci-dessus, j'utilise ensuite une procédure "save_emailsent" pour enregistrer le MAILEXCEL.
Cette procédure parcoure les sujets des mails du dossier "Éléments envoyés" dans Outlook, lorsqu'elle reconnait un sujet identique au MAILEXCEL, elle enregistre alors le mail détecté. Voici le code utilisé :

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
Public Sub save_emailsent(sujetdumail As String, chemin As String, nomdumail As String)
'initialisation
Dim sDate As String
Dim objItem As Object
Dim app As Outlook.Application
Dim AppNs As Outlook.Namespace
Dim AppFolder As Outlook.MAPIFolder
Dim mailenvoye As Boolean
mailenvoye = False
 
'on enregistre le mail envoyé
Set app = New Outlook.Application
Set AppNs = app.GetNamespace("MAPI")
Set AppFolder = AppNs.GetDefaultFolder(olFolderSentMail)
For Each objItem In AppFolder.Items
    If objItem.MessageClass = "IPM.Note" Then
        If objItem.Subject = sujetdumail Then
            sDate = Format(objItem.ReceivedTime, "yyyymmdd", vbUseSystemDayOfWeek, vbUseSystem) & Format(objItem.ReceivedTime, "-hhnnss", vbUseSystemDayOfWeek, vbUseSystem)
            Application.DisplayAlerts = False
            objItem.SaveAs chemin & sDate & " " & nomdumail & ".msg", olMSGUnicode
            Application.DisplayAlerts = True
            mailenvoye = True
            Exit For
        End If
    End If
Next
If mailenvoye = True Then
    MsgBox "Le mail a bien été envoyé et enregistré. Merci !"
Else
    MsgBox "ERREUR : le mail n'a PAS été trouvé, et donc pas enregistré."
End If
End Sub

La procédure "save_emailsent" s'exécute sans aucun problème. Pourtant, parfois elle ne trouve pas le MAILEXCEL, et donc ne l'enregistre pas.
Après vérification, le MAILEXCEL est pourtant bien présent dans le dossier "mail envoyé" d'Outlook.
Je n'ai pas réussi à comprendre quand l'erreur se produit. Elle se produit très ponctuellement (1 mail sur 20).

Voici mes questions :

1 - Mon idée sur cette erreur : peut-être que ponctuellement la procédure "save_emailsent" s'éxécute trop rapidement et que le MAILEXCEL n'a pas encore eu le temps d'être envoyé ?
Vous en pensez quoi ?

2 - Avez-vous déjà rencontré un problème similaire ?

3 - Utilisez-vous d'autres solutions pour enregistrer un mail envoyé depuis Outlook via Excel ?

Merci de votre aide

**joe.levrai** · 11/01/2017, 22h24

Bonjour,

c'est fort probablement le fait que la macro va plus vite à rechercher le mail (et par là même récupérer la collection pour la parcourir) qu'Outlook ne reçoit dans la collection cet élément

déjà, par pure logique, il est censé de se dire que, puisque ce mail vient d'être envoyé, c'est probablement le "premier" de ta collection en partant du plus récemment envoyé.

ce que je ferai à ta place (parce que personnellement je ne conçois pas de Save un Mail que je viens d'envoyer par VBA, en automation via Excel) :

- faire une boucle While
- tant que le premier mail de ma collection n'a pas pour objet le mail que je cherche
- je continue d'attendre et d'interroger l'objet du premier mail de la collection
- dès que j'ai enfin mon mail, je le traite

ce que je ferai si je DEVAIS monter ce type de procédé :

- je stocke chaque objet mail utilisé par le programme (si plusieurs envois dans la même journée)
- en fin de journée, je lance un programme qui ira chercher chaque mail envoyé pour les sauvegarder

et éventuellement :

- je rajoute dans le Champs .BCC : mon adresse d'envoi
- je met une règle de boite de réception pour isoler ces mails dans un dossier dédié (ou j'utilise l'évènement Item_Send du côté Outlook)
- je traite les mails du dossier dédié une fois par jour

autre piste à tester qui vient de me traverser l'esprit : je n'ai jamais essayé, mais je te laisse la main pour tester et nous dire
Si tu fais un .Display avant le .send, ne peux-tu pas faire un .Save vers ton PC avant l'envoi ??

mais là, on s'écarte d'Excel pour plutôt passer du côté Outlook (en termes de "quel forum pourra me répondre")

**altaar** · 12/01/2017, 09h57

Très bonne idée la boucle WHILE, je n'y avais même pas pensé.
J'ai donc rajouter dans mon code une boucle du type :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
```
1
2
3
Do Until [condition]
'Instructions
Loop
```
Je vais tester ça sur du long terme, mais je suis confiant j'ai le sentiment qu'on à résolu la faille !
Je clique sur "résolu" pour le moment, en espérant que ce soit bien le cas.
Si je ne reviens plus sur ce poste, alors vous pouvez considérer que c'est bon !

Merci pour les suggestions, mais ça ne correspond pas vraiment aux limites techniques imposé par mon système.

Alors j'avais testé en effet des choses similaires. Par exemple :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
```
1
2
3
.Display
.Send
.Save
```
Dans ce cas, Visual Basic considère que l'objet mail n'existe plus car il a déjà été envoyé, le code plante donc sur la ligne ".save".
Code : Sélectionner tout - Visualiser dans une fenêtre à part
```
1
2
3
.Display
.Save
.Send
```
Dans ce cas, Visual Basic enregistre le modèle de mail et non pas le mail envoyé comme je le souhaiterais. Ce modèle de mail ne contient pas d'heure d'envoi car il s'agit seulement du modèle de mail.

A ma connaissance le seul moyen d'enregistrer un mail envoyé (donc avec date + heure d'envoi), est donc de parcourir les dossiers de mails dans Outlook.

**altaar** · 12/06/2017, 11h36

En effet, après 5 mois d'utilisation je confirme que l'ajout d'une boucle DO UNTIL ... LOOP a résolu mon problème.
Voici donc le code dans son intégralité :

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
Public Sub save_emailsent(sujetdumail As String, chemin As String, nomdumail As String, celluledateenvoi As Range)
'initialisation
Dim sDate As String
Dim objItem As Object
Dim app As Outlook.Application
Dim AppNs As Outlook.Namespace
Dim AppFolder As Outlook.MAPIFolder
Dim mailenvoye As Boolean
mailenvoye = False
 
'on enregistre le mail envoyé
Set app = New Outlook.Application
Set AppNs = app.GetNamespace("MAPI")
Set AppFolder = AppNs.GetDefaultFolder(olFolderSentMail)
Do Until mailenvoye = True
    For Each objItem In AppFolder.Items
        If objItem.MessageClass = "IPM.Note" Then
            If objItem.Subject = sujetdumail Then
                sDate = Format(objItem.ReceivedTime, "yyyymmdd", vbUseSystemDayOfWeek, vbUseSystem) & Format(objItem.ReceivedTime, "-hhnnss", vbUseSystemDayOfWeek, vbUseSystem)
                Application.DisplayAlerts = False
                objItem.SaveAs chemin & sDate & " " & nomdumail & ".msg", olMSGUnicode
                Application.DisplayAlerts = True
                celluledateenvoi = Date
                mailenvoye = True
                Exit For
            End If
        End If
    Next
Loop
If mailenvoye = True Then
    MsgBox "Le mail a bien été envoyé et enregistré. Merci !"
Else
    MsgBox "ERREUR : le mail n'a PAS été enregistré."
End If
End Sub

BUG PONCTUEL : enregistrer un mail envoyé depuis Outlook via Excel [Toutes versions]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager