Solved

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

Posted on 2001-07-11
18
2,953 Views
Last Modified: 2012-06-27
I have been trying to come up with a solution for this for years.  And now its driving me crazy.  

I want to have either a rule, custom action, or code that:

When a message arrives in my inbox from a certain sender i want the message to automatically be read (ie be "marked as read") without any intervention on my part.

Because of the point value of this I will be very selective on who will receive the points...the most straightforward, easiest to implement solution will most likely get them.

Thanks.

7-11-01 12:41 -- the suggested download states that "Does not affect the envelope icon on the system tray, which will still show new messages having arrived. "  

The solution will need to make the envelope icon in the system tray go away as well.
0
Comment
Question by:brandonrice
  • 5
  • 3
  • 3
  • +5
18 Comments
 
LVL 20

Expert Comment

by:Dufo G. Belski
ID: 6274211
Try the custom action "MarkRead", you can get it here:

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

0
 
LVL 8

Expert Comment

by:starl
ID: 6274292
you *cannot* make the envelope icon in the system tray go way. thats part of the outlook code you can't touch.
0
 
LVL 8

Expert Comment

by:starl
ID: 6274294
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.
0
 

Author Comment

by:brandonrice
ID: 6274418
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.
0
 
LVL 2

Expert Comment

by:TrueDrake
ID: 6274496
Hi,
Maybe you should filter these or use the Blocked Senders rules
Enjoy
0
 

Author Comment

by:brandonrice
ID: 6274502
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.
0
 
LVL 4

Expert Comment

by:hig
ID: 6275429
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!)
0
 
LVL 20

Expert Comment

by:Dufo G. Belski
ID: 6276543
Brandon, you may want to post a zero point question in the Outlook forum with a link back to this question.

question.http://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.
0
 
LVL 20

Expert Comment

by:Dufo G. Belski
ID: 6277692
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.
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 

Author Comment

by:brandonrice
ID: 6277706
thanks asyscokid for your advice and help :)
0
 

Expert Comment

by:dmmorse
ID: 6286640
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.
0
 
LVL 8

Expert Comment

by:starl
ID: 6295664
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.
0
 
LVL 16

Accepted Solution

by:
Neo_mvps earned 300 total points
ID: 6306997
I'm not sure which version of Outlook you are using, but the following example should meet your needs in removing the new mail icon from the system tray and marking an item read if running Outlook 2000 in Internet Mail Only mode. [It is the only version I tested under.  You can try it for other versions/modes and it shouldn't hurt anything since I tried to take into account any problems one might run into using the Win32API.)



Option Explicit

'Required Public constants, types & declares
'for the Shell_Notify API method
Public Const NIM_DELETE As Long = &H2

' 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

Private Declare Function Shell_NotifyIcon Lib "shell32.dll" _
   Alias "Shell_NotifyIconA" _
   (ByVal dwMessage As Long, _
   lpData As NOTIFYICONDATA) As Long
   
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, _
  ByVal lpWindowName As String) As Long

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.Subject = "[Clear Icon Sample]" Then
    Item.UnRead = False
    Item.Save
    Call RemoveNewMailIcon
  End If

  Set Item = Nothing
End Sub


Private Function RemoveNewMailIcon() As Boolean
 
  Dim hNewMailWnd As Long
  Dim pShell_Notify As NOTIFYICONDATA
  Dim hResult As Long

  ' Do not use a vbNullString here
  hNewMailWnd = FindWindow("rctrl_renwnd32", "")
 
  If (hNewMailWnd) Then
    'setup the Shell_Notify structure
    pShell_Notify.cbSize = Len(pShell_Notify)
    pShell_Notify.hwnd = hNewMailWnd
    pShell_Notify.uID = 0
   
    ' Remove it from the system tray and catch result
    hResult = Shell_NotifyIcon(NIM_DELETE, pShell_Notify)
   
    If (hResult) Then
      RemoveNewMailIcon = True
    Else
      RemoveNewMailIcon = False
    End If
  End If

End Function



Cheers,
/Neo

PS - Code sample should be placed in "ThisOutlookSession" for testing purposes.

PSS - Hi starl. ;)

PSS - Brandon, can you do me a favor and reduce the points on the question in the Outlook section to "0" and PAQ it when you do this one.  Then again... since I'm sure that this is the solution you are looking for (yep, i'm feeling cocky <eg>) you can award me both this question and the one in the Outlook section since it lead me here.  I like challenges and this one was a bitch to solve. (Took 3 days of thought and coding to come up with something that worked rock solid under Outlook 2000 Internet Mail Only mode.)

PSSS - I stayed away from the Sender property because it can trigger the Email Security enhancement that blocks access to key properties in Outlook.  If you have this installed, be forwarned that only Exchange and HP OpenMail users can get around the blocks implemented by MS.
0
 
LVL 16

Expert Comment

by:Neo_mvps
ID: 6309805
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



0
 

Author Comment

by:brandonrice
ID: 6310244
*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
0
 

Author Comment

by:brandonrice
ID: 6310257
*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
0
 
LVL 16

Expert Comment

by:Neo_mvps
ID: 6310771
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
0
 

Expert Comment

by:hesterloli
ID: 9017758
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?
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Problem: You created a new custom form in Outlook for your contacts (added fields, deleted fields, changed the layout of fields, whatever) and made it the default form for contacts. The good news is that all new contacts will utilize the new form. T…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This video shows the viewer how to set up and create Footnotes in their document. Click on the References tab: Select "Insert Footnote": Type in desired text:
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now