Does a procedure exist to generate the words Today, Yesterday, Monday, Last
Week, Two Weeks Ago, Last Month, Older etc. from a given date like emails are
displayed in Outlook.

TIA
Lee

Lee Hayton wrote:
Sounds like Outlook might have one, yeah.

Sarcasm aside, this is just a simple matter of definition.  Are you having
trouble determining how long ago something happened?  Or what generalized
category that might fit into?

Ha ha - very good.  I should have worded that better!

Well in the mean time I have been busy writing something myself which seems
to do the trick (code below) but I would have liked to have know the correct
way to do it.

My example is a little more complicated than I requested as I need to
generate words and a group sort order.

Thanks Karl.


' Used for Outlook Style Date Groups
Private M0 As Date, M1 As Date, M2 As Date, M3 As Date
Private FirstOfMonth As Date, FirstOfThisMonth As Date, FirstOFLastMonth As
Date '--------------------------------------------------------------------------------

Public Sub SetUpDateGroups()

On Error GoTo SUDGError

M0 = DateAdd("d", (Weekday(Date) - 2) * -1, Date)
M1 = M0 - 7: M2 = M0 - 14: M3 = M0 - 21

FirstOfMonth = DateAdd("d", (Day(M3) * -1) + 1, M3)

FirstOfThisMonth = DateAdd("d", (Day(Date) * -1) + 1, Date)
FirstOFLastMonth = DateAdd("m", -1, FirstOfThisMonth)

Exit Sub
SUDGError:
MsgBox Error(Err) & "( " & ")"
Resume Next
End Sub

Public Sub SetDateItem(ByVal Item As ReportRecordItem)

On Error GoTo SDIError

' Ignore empty fields
If Item.Value = "" Then Exit Sub

Dim dt As Date: dt = Format(Item.Value, "dd/mm/yyyy")

Select Case dt
Case Date
    Item.GroupCaption = "Date: Today"
    Item.GroupPriority = 0
Case Date - 1
    Item.GroupCaption = "Date: Yesterday"
    Item.GroupPriority = 1
Case Is >= M0
    Item.GroupCaption = "Date: " & WeekdayName(Weekday(dt, vbMonday))
    Item.GroupPriority = (7 - Weekday(dt)) + 2
Case Is >= M1
    Item.GroupCaption = "Date: Last Week"
    Item.GroupPriority = 9
Case Is >= M2
    Item.GroupCaption = "Date: 2 Weeks Ago"
    Item.GroupPriority = 10
Case Is >= M3
    Item.GroupCaption = "Date: 3 Weeks Ago"
    Item.GroupPriority = 11
Case Is >= FirstOfThisMonth
    Item.GroupCaption = "Date: Remainder of month"
    Item.GroupPriority = 12
Case Is >= FirstOFLastMonth
    Item.GroupCaption = "Date: Last Month"
    Item.GroupPriority = 13
Case Else
    Item.GroupCaption = "Date: Older"
    Item.GroupPriority = 14
End Select

Exit Sub
SDIError:
MsgBox Error(Err) & "( " & ")"
Resume Next

End Sub

Just for reference, check this out:

    FirstOfThisMonth = DateSerial(Year(Now), Month(Now), 1)
    FirstOfLastMonth = DateSerial(Year(Now), Month(Now) - 1, 1)

Yes, the second statement will even work if the month is January. This
should give you December 1st of last year:

    ? DateSerial(2006, 0 ,1)

Works with the day as well.

USB-Memorystick - serial number
Hpw to make a VB6 form appears and gets focus every 15 seconds
Writing to .TXT file question
Best way to extract a word from a sentence
Do we have such a container control?
Need help regarding the program... Please help me.. It's very Urgent
Book for web dev with VS2005?
color format
MSComm application hangs - comEventRxOver
Monthview control - run time 380 invalid property value