[dba-Tech] Outlook New Mail Notification

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


More information about the dba-Tech mailing list