Group by Flag then by Date (not Time)

Hi awtgroup,

I've had a play with the view settings and cant get the view your asking for.  I think therefore that it probably wont be possible.

Sory cant be more help.

Stuart

Greetings, awtgroup.

> then group by -Date-
Which date?  I was able to create a view that groups by Flag Status and Date Received.  

Cheers!

BlueDevilFan,

Do you know where you found the "Date Received" status?  Can you let me know what version and Service Pack you are running?

Thanks for your help,

-m

Outlook 2003, SP2, build 11.6568.6568

I created a new view, clicked on Group By and selected "Follow Up Flag" (Ascending) as the first group and "Received" (Descending) as the second group.  Received is under Frequently-used fields.

Did grouping it by Received sort by Date, or by Time?

-m

I have a typo in the code above.  Change this line

     Item.UserProperties.Item("DateReceived") = DateValue(Item.Received)

to

     Item.UserProperties.Item("DateReceived") = DateValue(Item.ReceivedTime)

BlueDevilFan,

That's excellent, thanks so much for that.

-m

You're welcome.

Two questions:
1.) How do you create a new code to add the new field to all messages already in my inbox
2.) How do you modify the code so I create a macro that performs the operation ad-hoc for individual message?

Hi, nick_c_73.

"1.) How do you create a new code to add the new field to all messages already in my inbox"
You can add it with code liek that below.

"2.) How do you modify the code so I create a macro that performs the operation ad-hoc for individual message?"
I'm a little unclear on what you're asking.  Are you asking how to modify the code so it only works against certain messages, those meeting some specific criteria?

Sub AddUserProp()
    Dim olkMsg As Outlook.MailItem, _
        olkProp As Outlook.UserProperty
    For Each olkMsg in Application.ActiveExplorer.Selection
        With olkMsg
            'Change YourPropertyName to the name of your property.'
            Set olkProp = olkMsg.UserProperties.Add("YourPropertyName", olText, True)
            'Change YourPropertyValue to the value you want to assign to your property.'
            olkProp.Value = "YourPropertyValue"
            .Save
        End With
    Next
    Set olkMsg = Nothing
    Set olkProp = Nothing
End Sub

Select allOpen in new window

This is how I modified your code:
Sub AddUserProp()
    Dim olkMsg As Outlook.MailItem, _
        olkProp As Outlook.UserProperty
    For Each olkMsg In Application.ActiveExplorer.Selection
        With olkMsg
            'Change YourPropertyName to the name of your property.'
            Set olkProp = olkMsg.UserProperties.Add("DateReceived", olDateTime, True)
            'Change YourPropertyValue to the value you want to assign to your property.'
            olkProp.Value = DateValue(olkMsg.ReceivedTime)
            .Save
        End With
    Next
    Set olkMsg = Nothing
    Set olkProp = Nothing
End Sub

No it works if I highlight a series of messages but falls over if the is something like a reply to meeting request.  I am not sure if this is why the code does not run automatically i.e. without me having to select the messages.

Corrected last paragraph of my previous message (must remember to read what I write before I submit!)

It works if I highlight a series of messages but falls over if there is something like a reply to meeting request.  I am not sure if this is why the code does not run automatically i.e. without me having to select the messages.

Got it.  Try this.

Sub AddUserProp()
    Dim olkMsg As Object, _
        olkProp As Outlook.UserProperty
    For Each olkMsg In Application.ActiveExplorer.Selection
        If olkMsg.Class = 43 Then
            With olkMsg
                'Change YourPropertyName to the name of your property.'
                Set olkProp = olkMsg.UserProperties.Add("DateReceived", olDateTime, True)
                'Change YourPropertyValue to the value you want to assign to your property.'
                olkProp.Value = DateValue(olkMsg.ReceivedTime)
                .Save
            End With
        End If
    Next
    Set olkMsg = Nothing
    Set olkProp = Nothing
End Sub

Select allOpen in new window

Thanks - works well.

You're welcome.

Hello, very good function

Can you help me aply this to multiple email accounts and not only to default?

Thank you

awesome!  thank you, this is great.

Hi, Nikos.

I'm assuming you mean the original solution.  If so, then

'Add a additional line like the following for each folder you want to monitor
Public WithEvents myInbox1 As Outlook.Items
Public WithEvents myInbox2 As Outlook.Items

Private Sub Application_Quit()
    Set myInbox1 = Nothing
    Set myInbox2 = Nothing
End Sub

Private Sub Application_Startup()
    'On the next line replace "Path_To_Folder" with the path to a folder.  Add one of these lines for each folder you want to monitor
    Set myInbox1 = OpenOutlookFolder("Path_To_Folder").Items
    Set myInbox2 = OpenOutlookFolder("Path_To_Folder").Items
End Sub

'Add one of these subroutines for each folder you want to monitor
Private Sub myInbox1_ItemAdd(ByVal Item As Object)
    Item.UserProperties.Add "DateReceived", olDateTime
    Item.UserProperties.Item("DateReceived") = DateValue(Item.Received)
    Item.Save
End Sub

Private Sub myInbox2_ItemAdd(ByVal Item As Object)
    Item.UserProperties.Add "DateReceived", olDateTime
    Item.UserProperties.Item("DateReceived") = DateValue(Item.Received)
    Item.Save
End Sub

Private Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        bolBeyondRoot As Boolean
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number <> 0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
        Next
    End If
    On Error GoTo 0
End Function

Select allOpen in new window