XL 2016 Comment détecter si mail envoyé

[Lolote83]

Bonjour à toutes et à tous,
Très régulièrement, je suis confronté a générer des mails automatiques en fonction de certaines données contenues dans mes classeurs.
Dans ce classeur, la macro qui rédige le mail est très simpliste et n'est en aucun cas en lien avec des données quelconques du classeur, mais le problème reste le même.
En fait, j'aimerai pouvoir détecter si la personne a bien envoyé le mail afin de pourvoir poursuivre la macro.

- Faire le traitement B si le mail n'a pas été envoyé (clic sur croix rouge).

- Faire le traitement A si le mail est bien envoyé (clic sur bouton Envoyé),

Je fais volontairement afficher le mail (display) afin de pouvoir, le cas échéant, y apporter des modifications de dernières minutes avant de cliquer sur le bouton ENVOYER.
Cependant, rien ne m’empêche de cliquer sur la croix rouge et hop, le mail ne part pas !!!!

La procédure jointe récupérée donne des résultats assez satisfaisants, mais la boucle de test tourne en rond si on clique sur la croix rouge (la macro n'est jamais vraiment arrêtée) et du coup je n'arrive pas à accéder au traitement B
Si clic sur la croix rouge,

En fait, il faudrait réussir a inter-réagir sur la boucle Test mais je n'y arrive pas ..... La macro tourne alors en boucle et on le constate par le fait que celle-ci est toujours active.... Pas de STOP ....

Merci pour vos retours

@+ Lolote83

 

[fanch55]

re
le mieux je pense et d'explorer le dossier des "Envoyé"
un peu comme ca vite fait

C'est ce que j'ai tenté de faire par la suite en explorant les "boite d'envoi", "Eléments envoyés" et "Brouillon" .
Cela marche correctement quand OUTLOOK est déjà ouvert en tache de fond,
mais se heurte à des erreurs quand il ne l'est pas: l'objet Outlook est "rincé" dès qu'on sort du display ( en mode modal ), il faut alors tenter de réassigner un nouvel objet Outlook , ce qui ne semble pas pouvoir toujours se faire avant un certain temps aléatoire . Bref, j'ai pas encore trouvé de solution perenne ...
Pour le fun, je joins le code sur lequel je butte encore :

Sub Envoi()
Dim LolApp As Outlook.Application
Dim Cix As String
    Set LolApp = New Outlook.Application
        With LolApp.CreateItem(0)
            .To = "toto@toto.fr"
            .To = "test.vba.fanch55@free.fr"
            .CC = ""
            .Subject = "Ceci est un essai de mail automatique"
            .BodyFormat = olFormatHTML
            xBody = "Bonjour le Forum," & "<BR>" & "<BR>"
            xBody = xBody & "Comment détecter si le mail a été envoyé ??" & "<BR>" & "<BR>"
            xBody = xBody & "Si clic sur le bouton Envoyé alors on Traitement A" & "<BR>" & "<BR>"
            xBody = xBody & "Si clic sur croix rouge, alors Traitement B" & "<BR>" & "<BR>"
            .HTMLBody = xBody
            Cix = .ConversationIndex:  ' Debug.Print "Cix =" & Cix
            .Display True
        End With
        
Application.Wait (Now + TimeValue("00:00:01"))
Get_Outlook:  On Error Resume Next
    Do While LolApp.Name <> "Outlook":   Set LolApp = New Outlook.Application: Loop
   ' On Error GoTo Get_Outlook
    
    Set Box = LolApp.GetNamespace("MAPI").GetDefaultFolder(16).Items ' Brouillon
    If Box.Count > 0 Then
        If Box.GetLast.ConversationIndex = Cix Then
            MsgBox "Le message est resté en brouillon" & vbLf & "L'envoi n'a pas été fait", vbCritical
            Exit Sub
        End If
    End If
    
    On Error GoTo 0
    Set Box = LolApp.GetNamespace("MAPI").GetDefaultFolder(4).Items ' Boite d'envoi
    If Box.Count > 0 Then
        If Box.GetLast.ConversationIndex = Cix Then
            MsgBox "Le message est dans la boite d'envoi", vbinfo
            Box.GetLast.Send ' <-- forcer l'envoi( bizarrement, les mails parfois y stagnent )
            Application.Wait (Now + TimeValue("00:00:02"))
        End If
    End If
        
    Set Box = LolApp.GetNamespace("MAPI").GetDefaultFolder(5).Items ' Eléments envoyés
    If Box.Count > 0 Then
        If Box.GetLast.ConversationIndex = Cix Then
            MsgBox "Le message a été envoyé", vbInformation
            Exit Sub
        End If
    End If
    
    MsgBox "L'envoi n'a pas été fait", vbCritical
   ' On nettoie les variables
    Set LolApp = Nothing
End Sub

 

[job75]

Au post #15 :

Si le mail n'est pas envoyé la boucle tourne sans fin.

En mettant un compteur dans cette boucle avec un test il est facile d'en sortir quand le compteur dépasse une certaine valeur, non ?

 

[fanch55]

Code joint à tester (inclus dans le fichier )
Si quelqu'un sait comment faire un outlook.mailitem.find sur une date avec des secondes, je suis preneur ...
( je suis resté 3 heures à chercher le mail strictement égal au CreationTime avec ses secondes sans succès )

Edit: Correction du code pour palier à une éventuelle latence d'Outlook pour envoyer un message ...

Voir mon post suivant

 

[Staple1600]

Bonsoir le fil

@fanch55
Serait-ce un bon conseil que nous donne Eugène ?

 

[fanch55]

Bonsoir le fil

@fanch55
Serait-ce un bon conseil que nous donne Eugène ?

C'est bien ce que je fais pour avoir le creationtime correct.
Mai c'est la recherche de celui-ci dans tous les mails d'une boite (brouillons,boite d'envoi et éléments envoyé) qui ne répond pas aux promesses de l'aide pour le Find ...

 

[Staple1600]

Re

@fanch55
Houps, je n'avais pas vu ton commentaire dans ton code
Désolé

 

[fanch55]

Correction du code pour palier à une éventuelle latence d'Outlook pour envoyer un message

Option Compare Text
Option Explicit
Public Time_Filter     As String
Public Ctime           As Date
Public olApp           As Outlook.Application
Sub Envoi()
Dim xBody As String

    Set olApp = New Outlook.Application
        'Set Mail = olApp.CreateItem(0)
        With olApp.CreateItem(0)
            .To = "toto@toto.fr"
            .To = "test.vba.fanch55@free.fr"
            .CC = ""
            .Subject = "Ceci est un essai de mail automatique"
            .BodyFormat = olFormatHTML
            xBody = "Bonjour le Forum," & "<BR>" & "<BR>"
            xBody = xBody & "Comment détecter si le mail a été envoyé ??" & "<BR>" & "<BR>"
            xBody = xBody & "Si clic sur le bouton Envoyé alors on Traitement A" & "<BR>" & "<BR>"
            xBody = xBody & "Si clic sur croix rouge, alors Traitement B" & "<BR>" & "<BR>"
            .HTMLBody = xBody
            .Save ' obligatoire pour avoir un creationtime correct, sauvegarde dans brouillon
            Ctime = .CreationTime
            ' le filtre ne fonctionne pas correctement si on précise les secondes
            ' du coup on se résigne à une plage d'une minute
            Time_Filter = "[CreationTime] > '" & Format(Ctime, "yyyy-mm-dd hh:nn") & "'" & _
                     " and [CreationTime] < '" & Format(DateAdd("n", 1, Ctime), "yyyy-mm-dd hh:nn") & "'"
           ' Time_Filter = "[entryId]='" & .EntryID & "'"
            .Display True
        End With
    Set olApp = Nothing
    
    If Mail_Sent(True) Then
        MsgBox "action A"
    Else
        MsgBox "action B"
    End If
    
        
End Sub
Function Mail_Sent(Optional Verbose = False) As Boolean
Dim Box     As Outlook.Items
Dim Mail    As Outlook.MailItem
Dim To_Send As Boolean
    
    Mail_Sent = False

    On Error GoTo Error_App
    Set olApp = New Outlook.Application
    
    Set Box = olApp.GetNamespace("MAPI").GetDefaultFolder(16).Items ' Brouillon
    If Box.Count > 0 Then
       Set Mail = Box.Find(Time_Filter)
       Do While Not Mail Is Nothing
            If Mail.CreationTime = Ctime Then Mail.Delete: Exit Do
            Set Mail = Box.FindNext
       Loop
    End If
    
    Set Box = olApp.GetNamespace("MAPI").GetDefaultFolder(4).Items ' Boite d'envoi
    If Box.Count > 0 Then
        On Error Resume Next ' parfois le mail dans cette boite est pris en exclusif par outlook
        Set Mail = Box.Find(Time_Filter)
        Do While Not Mail Is Nothing
            If Mail.CreationTime = Ctime Then
                If Verbose Then MsgBox "Le mail est dans la Boite d'envoi"
                To_Send = True
                Do While Not Mail Is Nothing
                    Mail.Send ' <-- on force l'envoi car bizarrement, les mails parfois y stagnent
                    DoEvents
                    If Err <> 0 Then Set Mail = Nothing
                Loop
                Exit Do
            End If
            Set Mail = Box.FindNext
        Loop
    End If
    
    Err.Clear: On Error GoTo 0
    Do
        Set Box = olApp.GetNamespace("MAPI").GetDefaultFolder(5).Items ' Eléments envoyés
        If Box.Count > 0 Then
           Set Mail = Box.Find(Time_Filter)
           Do While Not Mail Is Nothing
                If Mail.CreationTime = Ctime Then
                    If Verbose Then MsgBox "Le message a été envoyé", vbInformation
                    Mail_Sent = True
                    To_Send = False
                    Exit Do
                End If
                Set Mail = Box.FindNext
           Loop
        End If
    Loop Until Not To_Send
    
    If Not Mail_Sent And Verbose Then MsgBox "L'envoi n'a pas été fait", vbCritical
    Exit Function

Error_App:
    On Error Resume Next
    Set olApp = New Outlook.Application
    Do While olApp.Name <> "Outlook": Set olApp = New Outlook.Application: Loop
    On Error GoTo Error_App
    Resume
End Function

 

[Lolote83]

Bonjour à tous et merci par avance de vous être penchés sur mon problème.
Je vais donc essayer de répondre à chacun d'entre vous dans l'ordre des messages. C'est plus simple.

- @patricktoulon (post#14). Ton code fonctionne correctement d'après les quelques essais que j'ai pu faire. Par contre, aucun message tel que : "ho la!! ya kékechoze ki va pas" ou "èè ben non tu l'a dans le BABA c'est pas parti et moi j'en reviens pas LOL!!!" n'est affiché. Néanmoins, cela à l'air de fonctionner. Merci Patrick d'avoir apporté ta contribution.

- @job75 (post#15). J'y avait pensé et j'avais réalisé ceci avant d'abandonner car je ne voyais pas comment ou quelle valeur de compteur mettre pour que ce soit cohérent.

        ......
        ......
        ......
   
        xBody = xBody & "Si clic sur croix rouge, alors Traitement B" & "<BR>" & "<BR>"
        .HTMLBody = xBody
        .Display
        xCpt = 1
        On Error Resume Next
        Do
            DoEvents: Want = .Sent
            If xCpt = 5000 Then
                xEnvoye = False
                Exit Do
            Else
                Select Case Err.Number
                    Case Is = 0
                        xEnvoye = False
   
                    Case Is < 0
                        xEnvoye = True
                        Exit Do
                   
                End Select
            End If
            xCpt = xCpt + 1
        Loop While Err.Number = 0
    End With
 
    ' On nettoie les variables
    Set LobjMail = Nothing
    Set LolApp = Nothing
 
 
    If xEnvoye = True Then
        Call Traitement_A(xCpt)
    Else
        Call Traitement_B(xCpt)
    End If
End Sub

Enfin, avec cette façon, je sortais tout de même de cette satanée boucle ......
Merci d'être présent.

- @Staple1600 (post19) - J'ai suivi le lien mais pas poursuivi plus loin. Merci aussi à toi d'être là.

- @fanch55 (post22) - Fichier téléchargé et après des essais, cela a l'air de bien fonctionner aussi. Merci aussi à toi d'avoir planché sur le sujet et d'avoir participé activement

- @wDog66 , merci aussi pour ta proposition. L'idée d'un formulaire affichant l'intégralité du mail a fait son chemin et a fait aussi l'objet d'un essai. C'est le clic sur le bouton envoyé du formulaire qui envoi le mail. Du coup, je m’affranchis du .Display etc etc etc

Ici exemple du formulaire

- @kiki29 (post#7). J'ai suivi le lien mais il me semble que cela était fait directement dans l'interface d'Outlook. Je voulais éviter. Merci aussi pour le suivi.

- @Nico_J (post#8) - Du coup, pas testé ta solution mais merci aussi d'avoir participé.

Du coup, je ne pense avoir oublié personne.
Je passe le post en résolu à celui de @fanch55 mais merci à vous tous.
Je sais, cela peut paraitre injuste pour les autres mais on ne peut choisir qu'une seule personne.

1000 mercis à vous tous et à bientôt sur le forum pour de nouvelles aventures
@+ Lolote83

 

[patricktoulon]

re
Bonsoir à tous
de toute façon c'est le display qui vous ennuie
perso l’aperçu je me le fait dans un webbrowser dans un userform, uniquement si j'ai le body en html
pour afficher un simple text c'est pas la peine

parti de là,pas de problème pour boucler sur le folder 4 ou 5
sinon oui comme le montre @fanch55 ouvrir une autre instance et tout i countiti

on peut exploiter un vbs piloté aussi et là on est tranquille
c'est d'ailleurs ce que je fait quand j'ai une multitude mail avec corps différents à envoyer a x destinataire ou même un seul

bref solution il y a

 

[Staple1600]

Bonsoir le fil

on peut exploiter un vbs piloté aussi et là on est tranquille

Il y a mieux que le VBS
Par exemple PowerShell encore récemment
Et désormais Power Automate

Spoiler: Apparemment...

Ils aiment bien tout ce qui est Power chez Microsoft
PowerBI, PowerPivot PowerQuery et tutti quanti

 

[patricktoulon]

re
Bonsoir @Staple1600
si tu peux et sais piloter un poWershell par vba pourquoi pas
le tout est de se libérer de l'instance
avec un vbs (ou autres ) ce n'est pas vba qui lance outlook

 

[Staple1600]

Re

@patricktoulon
C'était un message à caractère informatif

PS: PowerShell se pilote tout seul.
Et ses scripts peuvent être lancés par la Planifcateurs de Tâches

Mais cela c'était avant
Avant PowerAutomate (et ou en général du couple RPA+IA qui prend de plus en plus d'ampleur)

PS: Un de ces quatres, va y avoir du mouron à se faire pour les travailleurs humains derrière leurs claviers.
Bientôt ils seront obsolètes