Correct Outlook Event to process all messages?

[lameid]

I feel absolutely crazy and silly as I know I have seen a solution before but I lost track of it before fixing and adjusting...

In Outlook, I understand that some events sometimes don't always reliably work on processing received messages... I have some commented out code and some other code... I think they fundamentally do the same thing but the commented out may be stale and doing less than the code that is not but both have the same fundamental problem of not firing on every message every time.

I also know there is an event that always works, I read about it... lost the information and can't find it again...

If someone could point me towards such a resource or share the information that would be great...

What does the code do? It creates values in a few user defined fields so I can get Outlook to display things I want. As a programmer, it messes with me that most Names are proper case and some are all upper case... Apparently if you have been with the company I work for over about 15 years or so this is the case. The other user defined field addresses the fact that I want to group on day received in my mailbox and display time only on the message lines to save some screen space. This may not work for all but helps me a lot. I think we used to be able to do this in an earlier version...

The annoying thing is as I group on the date received user defined field, if the code fails to run instead of a date the UDF is none and at the bottom of the list.... Scrolling to the end of the mailbox to check for failed to process messages is obnoxious as you can imagine... the second bit of code is a workaround for that but on the days I forget to check for none grouping... It can be very inconvenient.

Please someone be smarter than me or better at searching and find it.

'Private WithEvents Items As Outlook.Items
'Private Sub Application_Startup()
'  Dim olApp As Outlook.Application
'  Dim objNS As Outlook.NameSpace
'  Set olApp = Outlook.Application
'  Set objNS = olApp.GetNamespace("MAPI")
'  ' default local Inbox
'  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
'End Sub
'
'Private Sub Items_ItemAdd(ByVal Item As Object)
'
'  On Error GoTo ErrorHandler
'  Dim dtReceived As Date
'  Dim objProp As Outlook.UserProperty
'
'  Select Case TypeName(Item)
'    Case "ReportItem", "TaskRequestItem" 'ReportItem: NDR's - Non Delivery Reports
'        dtReceived = Item.CreationTime 'Looks like this is the "Received Date"
'    Case Else 'MailItem and MeetingItem I definitely saw working
'      dtReceived = Item.ReceivedTime
'  End Select
'  'MsgBox "Date Received is" & dtReceived 'Yes it is running
' 'Property added below needs added to inbox view if you want to see or group on it
'  Set objProp = Item.UserProperties.Add("ReceivedDateOnly", olDateTime, True)
'  objProp.Value = DateSerial(Year(dtReceived), Month(dtReceived), Day(dtReceived))
'  Item.Save 'item needs saved now that it has been updated
'ProgramExit:
'  Exit Sub
'ErrorHandler:
'  MsgBox Err.Number & " - " & Err.Description
'  Resume ProgramExit
'  Resume
'End Sub
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
  
  
  On Error GoTo ErrorHandler
  Dim Item As Object
  
  Dim dtReceived As Date
  Dim strFrom As String
  Dim objProp As Outlook.UserProperty
     
  Set Item = Session.GetItemFromID(EntryIDCollection)
  

   
    Select Case TypeName(Item)
      Case "ReportItem" 'ReportItem: NDR's - Non Delivery Reports
        dtReceived = Item.CreationTime 'Looks like this is the "Received Date"
        strFrom = "Outlook" 'Item.SenderName
      Case "TaskRequestItem"
        dtReceived = Item.CreationTime 'Looks like this is the "Received Date"
        strFrom = Item.SenderName
      Case Else 'MailItem and MeetingItem I definitely saw working
        'Debug.Print TypeName(Item)
        dtReceived = Item.ReceivedTime
        strFrom = Item.SenderName
    End Select
  'MsgBox "Date Received is" & dtReceived 'Yes it is running
  'Property added below needs added to inbox view if you want to see or group on it
  
  
  
  Set objProp = Item.UserProperties.Add("FromDisplay", olText, True)
  
      
  If InStr(1, strFrom, ",") And strFrom = UCase(strFrom) Then
    strFrom = StrConv(strFrom, vbProperCase)
  End If
        
  objProp.Value = strFrom
  
  
  
  Set objProp = Item.UserProperties.Add("ReceivedDateOnly", olDateTime, True)
  objProp.Value = DateSerial(Year(dtReceived), Month(dtReceived), Day(dtReceived))
  Item.Save 'item needs saved now that it has been updated

ProgramExit:
   Exit Sub
ErrorHandler:
   MsgBox Err.Number & " - " & Err.Description
   Resume ProgramExit
   Resume
    
End Sub

So that works except when it doesn't so I also have the below that does the same thing but for selected items...

Sub FixSelectedItems()
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Dim olItems As Outlook.Items
  Dim olUserProp As Outlook.UserProperty
  Dim Item As Object
  'Dim ReportItem As Outlook.ReportItem
  
  Dim dtReceived As Date
  Dim dtReceivedDateOnly As Date
  Dim strFrom As String
  Dim objProp As Outlook.UserProperty
  
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  ' default local Inbox
  'Set olItems = olApp.ActiveExplorer.Selection
  
  For Each Item In olApp.ActiveExplorer.Selection
    
        
    Select Case TypeName(Item)
      Case "ReportItem" 'ReportItem: NDR's - Non Delivery Reports
        dtReceived = Item.CreationTime 'Looks like this is the "Received Date"
        strFrom = "Outlook" 'Item.SenderName
      Case "TaskRequestItem"
        dtReceived = Item.CreationTime 'Looks like this is the "Received Date"
        strFrom = Item.SenderName
      Case Else 'MailItem and MeetingItem I definitely saw working
        'Debug.Print TypeName(Item)
        dtReceived = Item.ReceivedTime
        strFrom = Item.SenderName
    End Select
    
    Set olUserProp = Item.UserProperties.Find("FromDisplay")

    If olUserProp Is Nothing Then
      Set olUserProp = Item.UserProperties.Add("FromDisplay", olText, True)
    Else
    End If
        
    If InStr(1, strFrom, ",") And strFrom = UCase(strFrom) Then
      strFrom = StrConv(strFrom, vbProperCase)
    End If
          
    If olUserProp.Value = strFrom Then
      'Nothing to do
    Else
      olUserProp.Value = strFrom
      Item.Save 'item needs saved now that it has been updated
    End If
    
    
    
    Set olUserProp = Item.UserProperties.Find("ReceivedDateOnly")
    
    If olUserProp Is Nothing Then
      Set olUserProp = Item.UserProperties.Add("ReceivedDateOnly", olDateTime, True)
    Else
    End If
    dtReceivedDateOnly = DateSerial(Year(dtReceived), Month(dtReceived), Day(dtReceived))
    If olUserProp.Value = dtReceivedDateOnly Then
      'Nothing to do
    Else
      olUserProp.Value = DateSerial(Year(dtReceived), Month(dtReceived), Day(dtReceived))
      Item.Save 'item needs saved now that it has been updated
    End If
SkipLoop:
  Next
  MsgBox "FixSelectedItems Complete."
End Sub

 

[mintjulep]

For Each Item In olApp.ActiveExplorer.Selection

This restricts the code within this for each loop to less than "all messages".

 

[combo]

I'm afraid the NewMailEx event is an already updated Outlook event without the 16 mails limit. It still does not pick all new messages in some cases. There is an interesting analysis in a four-parts blog here and MS additional info here.

combo

 

[Andrzejek]

I don't know about others, but I hate to repeat lines of code.
I would set my variables in one place, and over-write them if needed.
And since you do not want the time portion in your [tt]dtReceived[/tt], I would just get what I need from the start with [tt]Int()[/tt]:

For Each Item In olApp.ActiveExplorer.Selection

    dtReceived = Item.CreationTime
    strFrom = Item.SenderName

    Select Case TypeName(Item)
      Case "ReportItem" 
        strFrom = "Outlook"
      Case "TaskRequestItem"
        [green]'Do Nothing[/green]
      Case Else 
        dtReceived = Item.ReceivedTime
    End Select
    dtReceived = Int(dtReceived) [green]'Get just Date portion[/green]
    ...

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson