Michael R Mattys
michael.mattys at adelphia.net
Sun Nov 9 07:51:02 CST 2003
I have found three methods that might do the trick
of removing the Outlook envelope icon from the tray.
See below sig ...
(I know these don't work in Outlook Express because
the function is "hardwired" into the app)
Michael R. Mattys
Try MattysMapLib for MapPoint at
www.mattysconsulting.com
'Method 1
'---------------------------------------------------------------------------
------------------------------
'Author is NEO
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
'Method 2
'---------------------------------------------------------------------------
------------------------------
Public Sub sbMarkRead()
Dim Olfolder As Outlook.MAPIFolder
Dim Olfolder1 As Outlook.MAPIFolder
' Dim Olfolder As Outlook.MAPIFolder
Dim OlItems As Outlook.Items
Dim OlRecips As Outlook.Recipients
Dim OlRecip As Outlook.Recipient
Dim Olapp As Outlook.Application
Dim Olmapi As Outlook.NameSpace
Dim OlMail As Outlook.MailItem
Set Olapp = CreateObject("Outlook.Application")
Set Olmapi = Olapp.GetNamespace("MAPI")
'Open the inbox
Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)
Set OlItems = Olfolder.Items
'Set up the folders the mails are going to be deposited in
Set Olfolder1 = Olmapi.Folders("Mailbox - Your Profile").Folders("Your
Folder")
Do Until OlItems.Count = 0
'Reset the olitems object otherwise new incoming mails and moving mails get
missed
Set OlItems = Olfolder.Items
For Each OlMail In OlItems
If OlMail.UnRead = True Then
OlMail.UnRead = False 'Mark mail as read
If InStr(1, OlMail.Subject, "SPAM Message") > 0 Then
OlMail.Move Olfolder1 'move to folder1
End If
End If
Next OlMail
Loop
End Sub
'Method 3
'---------------------------------------------------------------------------
------------------------------
'########################################
'Installation instructions for OutLook 2000:
' Go to the Tools/Macros/Visual Basic Editor
' Click on ThisOutlookSession in the project window
' Replace the source code in the window with the following (adapt any
' existing code if neccessary)
'
' You may need to enable macros the first time it runs
'########################################
'Private Sub Application_NewMail()
' Call SuppressSpamNewMailNotification
'End Sub
'***********************************************
'Author: Rich Alger
'Description: This procedure suppresses the new mail notification any new
mail sent to the folder named 'Spam'
' The folder 'Spam' should be a sub folder of the Inbox
' It does this by opening the mail and immediately closing it.
' This also marks the mail as read
' Hopefully this does not send a signal to the sender that this E-mail
address is active
' This keeps the outlook new mail notification from firing.
' A new mail sound, dialog box and/or system tray icon will not result.
'***********************************************
Private Function SuppressSpamNewMailNotification() As Long
On Error GoTo ErrHandler
Dim nsSession As NameSpace
Dim fldrInbox As MAPIFolder
Dim fldrSpam As MAPIFolder
Dim itmMail As MailItem
Dim insMailInspector As Inspector
Dim sCriteria As String
SuppressSpamNewMailNotification = -1
Set nsSession = ThisOutlookSession.session
Set fldrInbox = nsSession.GetDefaultFolder(olFolderInbox)
Set fldrSpam = fldrInbox.Folders("Spam")
'Establish the criteria for new mail
sCriteria = "[UnRead]=True"
Set itmMail = fldrSpam.Items.Find(sCriteria)
'Determine if the item was found.
If itmMail Is Nothing Then
' fine - no item found
Else
Set insMailInspector = itmMail.GetInspector
insMailInspector.Display
insMailInspector.Close (olDiscard)
End If
SuppressSpamNewMailNotification = 0
CleanUp:
On Error Resume Next
Set fldrInbox = Nothing
Set fldrSpam = Nothing
Set itmMail = Nothing
Set insMailInspector = Nothing
Set nsSession = Nothing
Exit Function
ErrHandler:
MsgBox "Error suppressing spam new mail notification. " +
Err.DESCRIPTION, vbOKOnly, "Error " + CStr(Err.Number)
Resume CleanUp
End Function