Discussion :

[polim78]

Bonjour à tous,

Voici mon grand problème. Dans le code ci dessous, je peux checker que la boite d'envoi s'est incrémenté de 1 et donc savoir que mon mail est parti.
Or, si je ferme ma fenetre Outlook, toute l'appli plante puisque ma boucle

Code :

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

1
2
While IsSentMail(oApp, counter) = False
Wend

va rester à false. Donc, je voudrais savoir s'il est possible de remédier à ce problème : Ne pas être obligé d'envoyer un mail si la fenetre est ouverte.

Cordialement, polim78.

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
Private Sub Envoyer_Click()
Dim oNmSpce As Outlook.NameSpace, oOutbox As Outlook.MAPIFolder
Dim oApp As Outlook.Application
Dim oMail As MailItem
Dim counter As Integer
Set oApp = CreateObject("Outlook.application")
Set oMail = oApp.CreateItem(olMailItem)
Set oNmSpce = oApp.GetNamespace("MAPI")
Set oOutbox = oNmSpce.GetDefaultFolder(olFolderSentMail)
 
counter = oOutbox.Items.Count
 
oMail.Display
oMail.Body = Me!Message
oMail.Subject = Me!Objet
oMail.To = Me!Destinataire
 
While IsSentMail(oApp, counter) = False
Wend
Set oMail = Nothing
Set oApp = Nothing
End Sub
Public Function IsSentMail(olApp As Outlook.Application, counter As Integer) As Boolean
Dim oNmSpce As Outlook.NameSpace, oOutbox As Outlook.MAPIFolder
Dim bValRetour As Boolean
 
Set oNmSpce = olApp.GetNamespace("MAPI")
Set oOutbox = oNmSpce.GetDefaultFolder(olFolderSentMail)
 
If oOutbox.Items.Count = counter + 1 Then
   bValRetour = True
Else
   bValRetour = False
End If
Set oOutbox = Nothing
Set oNmSpce = Nothing
 
IsOutboxEmpty = bValRetour
End Function

[ClaudeLELOUP]

Bonjour,

Je ferais comme ceci :

Dans un module, pour disposer de la fonction KillApp :

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
Option Compare Database
Option Explicit
 
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, _
   lpdwprocessid As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, _
   ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
   ByVal nIndex As Long) As Long
Private Const WM_CLOSE = &H10
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU = &H80000
 
Private Function CloseWindow(ByVal hwnd As Long, ByVal hInstance As Long) As Long
 
Dim idproc As Long
 
idproc = 0
 
' Reçoit dans idproc l'id du processus lié à cette fenêtre
GetWindowThreadProcessId hwnd, idproc
If (idproc = hInstance) And ((GetWindowLong(hwnd, GWL_STYLE) And WS_SYSMENU) = WS_SYSMENU) Then
     PostMessage hwnd, WM_CLOSE, 0, 0
End If
 
' Obligatoire pour qu'EnumWindows continue l'énumération
CloseWindow = True
 
End Function
Public Sub KillApp(hInstance As Long)
 
EnumWindows AddressOf CloseWindow, hInstance
 
End Sub

et dans le module de ton formulaire :

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
Private Sub Envoyer_Click()
Dim oNmSpce As Outlook.NameSpace, oOutbox As Outlook.MAPIFolder
Dim oApp As Outlook.Application
Dim oMail As MailItem
Dim counter As Integer
Dim ret As Integer
'ouvrir OutLook
ret = Shell("C:\Program Files (x86)\Microsoft Office\Office14\OUTLOOK.EXE /profile adl", vbHide) ' à adapter !!!
Set oApp = CreateObject("Outlook.application")
Set oMail = oApp.CreateItem(olMailItem)
Set oNmSpce = oApp.GetNamespace("MAPI")
Set oOutbox = oNmSpce.GetDefaultFolder(olFolderSentMail)
 
counter = oOutbox.Items.Count
 
oMail.Display
oMail.Body = Me!Message
oMail.Subject = Me!Objet
oMail.To = Me!Destinataire
oMail.send
While counter = oOutbox.Items.Count
Wend
'Fermer Outlook
KillApp (ret)
 
Set oMail = Nothing
Set oApp = Nothing
End Sub

Aussi sur ce sujet : http://www.developpez.net/forums/d14...-mail-outlook/

[polim78]

Bonjour Mr LELOUP,

Merci pour votre réponse.

Votre manière d'aborder ici nous oblige à envoyer le mail directement depuis l'application.
Or, j'avais déjà réussi à régler ce problème avec mon code précédent. Cela ne posait pas de souci.

Ce que je voulais savoir, c'est s'il y avait un moyen,dans la boucle qui vérifie l'envoi d'un mail,

Code :

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

1
2
3
4
While IsSentMail(oApp, counter) = False
Wend

de surveiller le processus et de voir qu'il est toujours actif. S'il ne l'est plus, on sortirait de la boucle.
Donc je saurai quand sortir de la boucle.

J'ai vu ce code qui pourrait être intéressant à adapter, qu'en pensez-vous :
http://docvb.free.fr/apidetail.php?idapi=140

[ClaudeLELOUP]

Bonjour,

Votre manière d'aborder ici nous oblige à envoyer le mail directement depuis l'application.

Effectivement.

Désolé de ne pouvoir t'aider : je ne vois pas comment – dans ce contexte – utiliser l'API renseignée.

[jimbolion]

Claude, Polim78

Une autre méthode sans utilisation de L'API

http://vb.developpez.com/faq/?page=Systeme#listprocess

Dans ce cas lister la liste des procédures ouvertes et vérifier quelle qui t'intéresse n'existe plus. Cette procédure est à glisser entre ton while...wend et te retournerait alors un indicateur booleen en fonction de ce que tu cherches à connaître.

while retourfonction = false .... wend

JimBoLion

[ClaudeLELOUP]