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.
So that works except when it doesn't so I also have the below that does the same thing but for selected items...
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.
Code:
'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 SubSo that works except when it doesn't so I also have the below that does the same thing but for selected items...
Code:
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