The following class retrieves the starting and end dates for the Current Hour/Day/Week/Month/Year:
Option Explicit
Public Property Get CurrentHour() As Collection
Set CurrentHour = New Collection
CurrentHour.Add CDate(Date & " " & Format(Now, "HH") & ":00:00"),
"StartDateTime"
CurrentHour.Add CDate(Date & " " & Format(Now, "HH") & ":59:59"),
"EndDateTime"
End Property
Public Property Get CurrentDay() As Collection
Set CurrentDay = New Collection
CurrentDay.Add CDate(Date), "StartDateTime"
CurrentDay.Add CDate(Date & " 23:59:59"), "EndDateTime"
End Property
Public Property Get CurrentWeek() As Collection
Set CurrentWeek = New Collection
CurrentWeek.Add CDate((Date - Weekday(Date) + 1)), "StartDateTime"
CurrentWeek.Add CDate((Date - Weekday(Date) + 7) & " 23:59:59"),
"EndDateTime"
End Property
Public Property Get CurrentMonth() As Collection
Set CurrentMonth = New Collection
CurrentMonth.Add CDate(Month(Date) & "/01/" & Year(Date)), "StartDateTime"
CurrentMonth.Add CDate(Month(Date) + 1 & "/01/" & Year(Date) - 1 & "
23:59:59"), "EndDateTime"
End Property
Public Property Get CurrentYear() As Collection
Set CurrentYear = New Collection
CurrentYear.Add CDate("01/01/" & Year(Date)), "StartDateTime"
CurrentYear.Add CDate("12/31/" & Year(Date) & " 23:59:59"), "EndDateTime"
End Property
Implementation
Dim TR As New TimeRanges
If optHour.Value Then
Label1.Caption = TR.CurrentHour("StartDateTime") & " "
Label1.Caption = Label1.Caption & TR.CurrentHour("EndDateTime")
End If
If opttoday.Value Then
Label1.Caption = TR.CurrentDay("StartDateTime") & " "
Label1.Caption = Label1.Caption & TR.CurrentDay("EndDateTime")
End If
If optWeek.Value Then
Label1.Caption = TR.CurrentWeek("StartDateTime") & " "
Label1.Caption = Label1.Caption & TR.CurrentWeek("EndDateTime")
End If
If optMonth.Value Then
Label1.Caption = TR.CurrentMonth("StartDateTime") & " "
Label1.Caption = Label1.Caption & TR.CurrentMonth("EndDateTime")
End If
If optYear.Value Then
Label1.Caption = TR.CurrentYear("StartDateTime") & " "
Label1.Caption = Label1.Caption & TR.CurrentYear("EndDateTime")
End If
