Supprimer l'icone dans le systray

[pc75]

Bonjour,

J'ai écrit une macro qui supprime certains messages à leur arrivée.

Mon problème est que l'enveloppe qui s'affiche dans le systray à l'arrivée d'un nouveau message reste affichée alors que je n'ai plus de nouveau message.

Si quelqu'un connait la syntaxe pour faire disparaitre cette icone ?

Merci

[pc75]

Re,

Personne n'a une petite idée ?

Merci

[cavo789]

Bonjour, j'ai lu ta question hier et j'ai immédiatement pensé à un truc mais aussitôt je me suis dit que cela ne fonctionnerait sans doute pas mais puisque tu insistes :

En tant que programmeur, si je veux mettre à jour l'icône de mon soft depuis le systray, je change le handle de l'icône et je force un refresh de mon formulaire

==> appliqué à OUtlook, cela pourrait donner : tu retrouves le handle de la fenêtre principale de Outlook et tu forces un refresh avec une API de Windows.

Avec un peu de chance cela va faire un reset de l'icône.

Si pas, juste avant le refresh, essaie de retrouver le handle de l'icône "par défaut" (c-à-d celle qu'Outlook affiche en l'absence de nouveau mail); force ce handle et fait un refresh.


=====> mais je doute fort que cela fonctionne

[pc75]

Re,

Merci de ta réponse, mais c'est un peu hard.

Par contre, si j'ouvre (dans Outlook) un message déjà marqué comme LU, ça fait disparaitre l'enveloppe.

Est-il possible de simuler cette même action dans ma macro ?

[cavo789]

Je savais que c'était hard mais comme tu étais vraiment désireux d'une réponse...

Ouvrir un mail. Oui, je présume que c'est possible.

Si tu instancies le inbox folder puis le premier item de type olMailItem et qu'ensuite tu fais un .Open de l'objet, cela devrait marcher non ?

Désolé de ne pas mettre de code mais j'écris très très très très peu de code Outlook.

[Heureux-oli]

J'ai fait un test sur le fait de mettre les mails comme étant lus, l'enveloppe reste.

Possible qu'en les ouvrant.

[pc75]

Envoyé par Heureux-oli

J'ai fait un test sur le fait de mettre les mails comme étant lus, l'enveloppe reste.

Possible qu'en les ouvrant.

J'avais tenté aussi de mettre la propriété UnRead à False et effectivement, l'enveloppe reste.

Je continue de chercher, mais s'il y a d'autres idées ?

Merci

[Oliv-]

Hellooo,
Je crois que je vais faire ton bonheur :
que je n'ai pas testé .

Code :

1
2
3
4
5
Private Sub Application_NewMail()
     ' add some code to check whether the latest items are "interesting"
     ' if not interesting, clear the envelope icon
     Call RemoveNewMailIcon 
End Sub

Code :

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
' Code sample by Outlook MVP "Neo"
' Removes the New Mail icon from the Windows system tray,
' and resets Outlook's new mail notification engine.
' Tested against Outlook 2000 (IMO) and Outlook 2002 (POP Account)
 
' Send questions and comments to neo@mvps.org
 
' WARNING: Due to the use of AddressOf, code must
' go into a module and not ThisOutlookSession or
' a class module
 
' Entry Point is RemoveNewMailIcon.
 
Option Explicit
 
Public Const WUM_RESETNOTIFICATION As Long = &H407
 
'Required Public constants, types & declares
'for the Shell_Notify API method
Public Const NIM_ADD As Long = &H0
Public Const NIM_MODIFY As Long = &H1
Public Const NIM_DELETE As Long = &H2
 
Public Const NIF_ICON As Long = &H2 'adding an ICON
Public Const NIF_TIP As Long = &H4 'adding a TIP
Public Const NIF_MESSAGE As Long = &H1 'want return messages
 
' Structure needed for Shell_Notify API
Type NOTIFYICONDATA
  cbSize As Long
  hwnd As Long
  uID As Long
  uFlags As Long
  uCallbackMessage As Long
  hIcon As Long
  szTip As String * 64
End Type
 
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  (ByVal hwnd As Long, ByVal wMsg As Long, _
  ByVal wParam As Integer, ByVal lParam As Any) As Long
 
Declare Function GetClassName Lib "user32" _
  Alias "GetClassNameA" _
  (ByVal hwnd As Long, _
  ByVal lpClassName As String, _
  ByVal nMaxCount As Long) As Long
 
Declare Function GetWindowTextLength Lib "user32" _
  Alias "GetWindowTextLengthA" _
  (ByVal hwnd As Long) As Long
 
Declare Function GetWindowText Lib "user32" _
  Alias "GetWindowTextA" _
  (ByVal hwnd As Long, _
  ByVal lpString As String, _
  ByVal cch As Long) As Long
 
Declare Function EnumWindows Lib "user32" _
  (ByVal lpEnumFunc As Long, _
  ByVal lParam As Long) As Long
 
Declare Function Shell_NotifyIcon Lib "shell32.dll" _
  Alias "Shell_NotifyIconA" _
  (ByVal dwMessage As Long, _
  lpData As NOTIFYICONDATA) As Long
 
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, _
  ByVal lpWindowName As String) As Long
 
' This is the entry point that makes it happen
Sub RemoveNewMailIcon()
  EnumWindows AddressOf EnumWindowProc, 0
End Sub
 
Public Function EnumWindowProc(ByVal hwnd As Long, _
  ByVal lParam As Long) As Long
 
  'Do stuff here with hwnd
  Dim sClass As String
  Dim sIDType As String
  Dim sTitle As String
  Dim hResult As Long
 
  sTitle = GetWindowIdentification(hwnd, sIDType, sClass)
  If sTitle = "rctrl_renwnd32" Then
    hResult = KillNewMailIcon(hwnd)
  End If
 
  If hResult Then
    EnumWindowProc = False
    ' Reset the new mail notification engine
    Call SendMessage(hwnd, WUM_RESETNOTIFICATION, 0&, 0&)
  Else
    EnumWindowProc = True
  End If
End Function
 
Private Function GetWindowIdentification(ByVal hwnd As Long, _
  sIDType As String, _
  sClass As String) As String
 
  Dim nSize As Long
  Dim sTitle As String
 
  'get the size of the string required
  'to hold the window title
  nSize = GetWindowTextLength(hwnd)
  'if the return is 0, there is no title
  If nSize > 0 Then
    sTitle = Space$(nSize + 1)
    Call GetWindowText(hwnd, sTitle, nSize + 1)
    sIDType = "title"
    sClass = Space$(64)
    Call GetClassName(hwnd, sClass, 64)
  Else
    'no title, so get the class name instead
    sTitle = Space$(64)
    Call GetClassName(hwnd, sTitle, 64)
    sClass = sTitle
    sIDType = "class"
  End If
 
  GetWindowIdentification = TrimNull(sTitle)
End Function
 
Private Function TrimNull(startstr As String) As String
  Dim pos As Integer
  pos = InStr(startstr, Chr$(0))
  If pos Then
    TrimNull = Left(startstr, pos - 1)
    Exit Function
  End If
 
  'if this far, there was
  'no Chr$(0), so return the string
  TrimNull = startstr
End Function
 
Private Function KillNewMailIcon(ByVal hwnd As Long) As Boolean
  Dim pShell_Notify As NOTIFYICONDATA
  Dim hResult As Long
 
  'setup the Shell_Notify structure
  pShell_Notify.cbSize = Len(pShell_Notify)
  pShell_Notify.hwnd = hwnd
  pShell_Notify.uID = 0
 
  ' Remove it from the system tray and catch result
  hResult = Shell_NotifyIcon(NIM_DELETE, pShell_Notify)
  If (hResult) Then
    KillNewMailIcon = True
  Else
    KillNewMailIcon = False
  End If
End Function

[pc75]

Re,

Merci, ça fonctionne.

Un autre petit souci :

Dans l'évenement NewMail, je boucle sur les non lus.
Je sauvegarde l'objet et le sujet du message dans des variables
Je me positionne sur Elements supprimés
Je boucle sur les non lus jusqu'à ce que je retrouve le même objet et sujet
Je supprime le message

Sauf que le message dans Elements supprimés n'est supprimé 'une fois sur deux ou trois.
J'ai l'impression que quand je me positionne dans Elements supprimés, le message que je viens de supprimer dans Inbox n'est pas encore arrivé.

Une idée ?

Et merci encore à catteau13

[Oliv-]

Peut être en utilisant à la palce l'événement NewmailEx

[pc75]

Envoyé par catteau13

Peut être en utilisant à la palce l'événement NewmailEx

Merci, mais je ne vois pas cet évenement ?

PS : Je suis sous Outlook 2000

[Oliv-]

Salut,
Effectivement la méthode delete de Outlook envoi le mail dans les éléments supprimés.

Il faut le faire avec CDO voic un exemple :

Code :

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
Sub DeleteSelectedItem()
    Dim objApp As Outlook.Application
    Dim objItem As Object
    Dim objCDO As MAPI.Message
    Dim objCDOSession As MAPI.Session
    Dim strEntryID As String
    Dim strStoreID As String
 
    Set objApp = CreateObject("Outlook.Application")
    Set objItem = objApp.ActiveExplorer.Selection.Item(1)
    If Not objItem Is Nothing Then
        Set objCDOSession = CreateObject("MAPI.Session")
        objCDOSession.Logon "", "", False, False
        strEntryID = objItem.EntryID
        strStoreID = objItem.Parent.StoreID
        Set objCDO = objCDOSession.GetMessage(strEntryID, strStoreID)
        If Not objCDO Is Nothing Then
            objCDO.Delete
        End If
    End If
 
    objCDOSession.Logoff
    Set objCDOSession = Nothing
    Set objItem = Nothing
    Set objCDO = Nothing
    Set objApp = Nothing
End Sub

[pc75]

OK, et merci

[pc75]

Re,

Je viens de tester le code (via CDO), et j'ai un souci.

Dans Application_NewMail, je boucle sur les non lus et quand je trouve un certain mot dans le sujet, j'appelle la procédure DeleteSelectedItem.

Mais pour supprimer le msg en question, il faut qu'il soit sélectionné. Et je n'ai pas trouvé la méthode qui permet de sélectionner un message en particulier.

Si quelqu'un sait ?

Merci

[Oliv-]

SAlut,
As tu dans ta version ol2000 la possibilité d'exécuter un script sur une règle de message ? tu pourrais ainsi éviter de boucler sur tous les mails.

Sinon il faut modifier la macro DeleteSelectedItem en rendant la variable objet objItem public et l'envoyant à partir de ton code initial.

Il faudrait que tu publis ton code pour que je t'aide à le modifier.

Oliv'

[pc75]

Merci,

voilà mon code

Code :

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
 
Private Sub Application_NewMail()
Dim myOlApp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim i As Integer
Dim j As Long
Dim Sujet As String
Dim Corps As String
Dim s As Integer
Dim x As Integer
Dim Existe As Boolean
 
' Sélection du dossier "Boite de réception"
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myOlApp.ActiveExplorer.CurrentFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
 
' Boucler sur les non-lus
For i = 1 To Explorers.Item(0).CurrentFolder.UnReadItemCount
    If Explorers.Item(0).CurrentFolder.UnReadItemCount = 0 Then
        Exit Sub
    End If
 
    If InStr(UCase(Explorers.Item(0).CurrentFolder.Items.Item(i).Subject), "SPAM") > 0 Then
 
'DeleteSelectedItem
'' S'il n'y a plus de messages non lus => virer l'enveloppe du systray
'If Explorers.Item(0).CurrentFolder.UnReadItemCount = 0 Then
'    Call RemoveNewMailIcon
'End If
'Exit Sub
 
        ' Sauvegarde du sujet et du corps du message
        Sujet = Trim(Explorers.Item(0).CurrentFolder.Items.Item(i).Subject)
        Corps = Trim(Explorers.Item(0).CurrentFolder.Items.Item(i).Body)
        ' Suppression du message
        Explorers.Item(0).CurrentFolder.Items.Item(i).Delete
        ' Sélection du dossier "Eléments supprimés"
        Set myOlApp.ActiveExplorer.CurrentFolder = _
            myNameSpace.GetDefaultFolder(olFolderDeletedItems)
        Existe = False
        ' Attendre que le message supprimé arrive dans "Eléments supprimés"
        Do While Existe = False
            ' Boucler sur les non-lus
            For s = 1 To Explorers.Item(0).CurrentFolder.UnReadItemCount
                ' Suppression si même sujet et même corps
                    If Trim(Explorers.Item(0).CurrentFolder.Items.Item(s).Subject) = Sujet _
                And Trim(Explorers.Item(0).CurrentFolder.Items.Item(s).Body) = Corps Then
                    Explorers.Item(0).CurrentFolder.Items.Item(s).Delete
                    Existe = True
                    Exit For
                End If
            Next s
        Loop
    End If
 
    ' Sélection du dossier "Boite de réception"
    Set myOlApp.ActiveExplorer.CurrentFolder = _
        myNameSpace.GetDefaultFolder(olFolderInbox)
Next i
 
' S'il n'y a plus de messages non lus => virer l'enveloppe du systray
If Explorers.Item(0).CurrentFolder.UnReadItemCount = 0 Then
    Call RemoveNewMailIcon
End If
 
Set myOlApp = Nothing
Set myNameSpace = Nothing
End Sub

[Oliv-]

Et tu peux pas faire cela avec les règles tout simplement ?

Oliv'

[pc75]

Re,

J'avais essayé, mais les messages restaient dans Elements supprimés.

Je viens de regarder ma règle, et j'avais choisi l'option "Le supprimer" au lieu de "Le supprimer définitivement".

Donc, sujet résolu, mais je ne le marque pas tout de suite, car, pour le fun, ça m'intéressserait.

Merci

EDIT : Je relance le sujet => Les messages sont effectivement définitivement supprimés, mais il reste le problème de l'enveloppe qui reste dans le systray.

[Oliv-]

Lorsque tu lances uns macro ou une fonction tu peux lui ajouter des paramétres :

ici une variable avec du texte

Code :

1
2
3
4
5
6
7
sub maMacroInitiale()
macro_complementaire("bonjour")
end sub
 
sub macro_complementaire(toto as string)
msgbox toto
end sub

Tu peux aussi lui donner en paramétres une variable objet
ici avec un mail ouvert

Code :

1
2
3
4
5
6
7
8
9
10
Sub maMacroInitiale()
 
Dim oitem As Object
Set oitem = ActiveInspector.CurrentItem
macro_complementaire oitem
End Sub
 
Sub macro_complementaire(toto As Object)
MsgBox toto.Subject
End Sub

oitem et toto désignent donc la même chose.

Tu as donc 2 solutions pour ton problème il te faut maintenant recomposer le puzzle

Oliv'

[pc75]

Re,

C'est bien là mon problème.
Quand je boucle sur les non lus et que je trouve un sujet contenant SPAM, j'appelle la Sub DeleteSelectedItem.

Mais quelle info je dois passer en paramètre à cette sub pour deleter le bon mail ?