Apply "Mark as Read" to incoming emails from specific senders

Try the custom action "MarkRead", you can get it here:

http://www.slipstick.com/addins/custom.htm

you *cannot* make the envelope icon in the system tray go way. thats part of the outlook code you can't touch.

and brandon, please do not edit your original question to leave comments - please use the comment box at the bottom of your screen - it's much easier to understand and keep track of the conversation.

It would seem to me that if you can right-click on the message and say "mark as read" the envelope icon goes away...why did MS make it so difficult to program that functionality in a macro.  Its strange to me that Outlook doesnt have the "record macro" functionality like all th other office programs do.

I still think theres a way.  Someones had to have been as frustrated with this as I am, and figured out a way.

Hi,
Maybe you should filter these or use the Blocked Senders rules
Enjoy

It would seem to me that if you can right-click on the message and say "mark as read" the envelope icon goes away...why did MS make it so difficult to program that functionality in a macro.  Its strange to me that Outlook doesnt have the "record macro" functionality like all th other office programs do.

I still think theres a way.  Someones had to have been as frustrated with this as I am, and figured out a way.

Disable the following option for the envelope to go away:

Tools/Options.../Preferences tab/Email options.../Advanced email options.../Show an envelope icon in the system tray


(the envelope will not be shown for any new message!)

Brandon, you may want to post a zero point question in the Outlook forum with a link back to this question.

question.https://www.experts-exchange.com/jsp/qList.jsp?ta=msoutlook

However, as starl is the #6 expert in Outlook, if she says it can't be done, I'd tend to believe her.

Hi Brandon.  I saw your question in the Outlook forum and when I followed the link, I was all of a sudden logged on as you.  This is a known bug with EE.  I suggest you edit that link to remove section beginning &jsessionid=.

Also, when this issue is closed, I suggest you ask Community Support to refund the points you put on that question.

thanks asyscokid for your advice and help :)

I had a class in Exchange and asked the teacher the exact same question.  His response....Write custom code and that is all he said.  I am interested in know the answer to this also.

hig, I've looked at OL98 & 2000 and can't find the option? Are you using the new 2002? I admit that I haven't had a chance to review that version. Perhaps there MS finally gave ppl the option that they've wanted.

Any code that _would_ remove the envelope icon would be a hack and could mess up the operation of outlook or windows.

info from ms:
Systray.exe is a tool for system taskbar notifications. The taskbar provides a location for programs and hardware devices to display icons.


I've looked to see if anyone had any info/ideas and can't find anything...

the only thing I can think of - which I don't have the knowledge to do - would be to write a VB program that runs in the background and whenever a message is received, it opens/closes it in the background... but this would slow down your system some.

Just tested the sample above against Win2k(sp2) and Outlook 2000 (CW) and it failed.  Since I love a challenge, here is something that works for Corp/Workgroup.  (Entry point is RemoveNewMailIcon)


Option Explicit

'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 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

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
 
  'To continue enumeration, return True
  'To stop enumeration return False (0).
  'When 1 is returned, enumeration continues
  'until there are no more windows left.

  If hResult Then
    EnumWindowProc = False
  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

*BRAVO* Neo...

I thought someone could figure it out.  I had to scrounge the internet to find a way to call your procedure (see below) and it is in no way "good" code, but it works.  

Your solution works excellent tho.  The message does remain "unread" but I actually like that as I can go into my inbox and see which ones I didnt want to be notified of immediately.

Thank you so very much for solving this problem thats been annoying me for years.  

If you would like to clean up my code and post it bac on here that would be great, but you are under no obligation to do so.

Thanks again,

Brandon


Private Sub Application_NewMail()
   
    Dim oApp As Application
    Dim oNS As NameSpace
    Dim oMsg As Object
    Dim oFolder As Object
    Dim oAttachments As Outlook.Attachments
    Dim strControl
           
    Set oApp = New Outlook.Application
    Set oNS = oApp.GetNamespace("MAPI")
    Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
    strControl = 0
   
    For Each oMsg In oFolder.Items
        With oMsg
            If InStr(1, LCase(.SenderName), "[term in senders name]") > 0 Then
                'MsgBox "New Mail"
                RemoveNewMailIcon
            End If
            Exit For
        End With
    Next
End Sub

*BRAVO* Neo...

Youve solved this problem thats been annoying me for years.  

I had to write some code to kick off your RemoveNewMailIcon procedure (see below).  Since im an Outlook Macro novice it is pretty bad.

You have solved this problem.  If you would like to clean up my horribly written code to kick off your procedure that would be great...and post it here for everyone.  But you are under no obligation to do so as Ive awarded you your points.

Thanks,

Brandon



Private Sub Application_NewMail()
   
    Dim oApp As Application
    Dim oNS As NameSpace
    Dim oMsg As Object
    Dim oFolder As Object
    Dim oAttachments As Outlook.Attachments
    Dim strControl
           
    Set oApp = New Outlook.Application
    Set oNS = oApp.GetNamespace("MAPI")
    Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
    strControl = 0
   
    For Each oMsg In oFolder.Items
        With oMsg
            If InStr(1, LCase(.SenderName), "rice") > 0 Then
                'MsgBox "New Mail"
                RemoveNewMailIcon
'                strControl = strControl + 1
'                oMsg.Attachments.Item(1).SaveAsFile "C:\reports\in\" & strControl & "report.txt"
'                    .Delete
            End If
            Exit For
        End With
    Next
End Sub

Modified code sample.  Please notice the breaks since the solution requires some code to go into ThisOutlookSession and the rest into a module.


---- This goes into a module ------------

Option Explicit

'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 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

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
 
 'To continue enumeration, return True
 'To stop enumeration return False (0).
 'When 1 is returned, enumeration continues
 'until there are no more windows left.

 If hResult Then
   EnumWindowProc = False
 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




----- This goes into ThisOutlookSession  -----------------
Option Explicit

Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
 Dim objNS As NameSpace

 Set objNS = Application.GetNamespace("MAPI")

 ' instantiate objects declared WithEvents
 Set olInboxItems = _
   objNS.GetDefaultFolder(olFolderInbox).Items

 Set objNS = Nothing
End Sub

Private Sub Application_Quit()
 ' disassociate global objects declared WithEvents
 Set olInboxItems = Nothing
End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
  On Error Resume Next
 
  If Item.Class = olMail Then
    With Item
      If InStr(1, LCase(.SenderName), "[term in senders name]") > 0 Then
        'MsgBox "New Mail"
        RemoveNewMailIcon
      End If
    End With
  End If

 Set Item = Nothing

End Sub

It doesn't work.  Looks good and can be done manually but the last part where you call RemoveNewMail Icon in the ItemAdd event just doesn't work.  This has also been verified by Ken Slovack in the Outlook VBA newsgroup at Microsoft.  You also removed the SendMessage function from the Module.  Why?