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 ....
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>"...
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 :
VB:
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
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 ...
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 ...
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
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.
VB:
......
......
......
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
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
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