Could someone, anyone please tell me what I need to amend, to get this
function to take Sunday as the first day of the week?
I amended the Weekday parts to vbSunday (in my code, not the code
attached), yet when I ran it for 28/09/2003 (UK date format) it
returned Week 39. I would have expected it to return Week 40.
However, I'm really stuck and my head is busting over this, so any
pointers would be gratefully appreciated.
Many thanks in advance
Cheers,
Phil
'================================================
'Function obtained from Microsoft Knowledge Base
'Q200299. It returns correct Weeknumbers as per ISO 8601
'and works around known week numbering bug in Access
'================================================
Function WeekNumber(InDate As Date) As Integer
Dim DayNo As Integer
Dim StartDays As Integer
Dim StopDays As Integer
Dim StartDay As Integer
Dim StopDay As Integer
Dim VNumber As Integer
Dim ThurFlag As Boolean
On Error GoTo HandleErr
DayNo = Days(InDate)
StartDay = WeekDay(DateSerial(Year(InDate), 1, 1)) - 1
StopDay = WeekDay(DateSerial(Year(InDate), 12, 31)) - 1
' Number of days belonging to first calendar week
StartDays = 7 - (StartDay - 1)
' Number of days belonging to last calendar week
StopDays = 7 - (StopDay - 1)
' Test to see if the year will have 53 weeks or not
If StartDay = 4 Or StopDay = 4 Then ThurFlag = True Else ThurFlag =
False
VNumber = (DayNo - StartDays - 4) / 7
' If first week has 4 or more days, it will be calendar week 1
' If first week has less than 4 days, it will belong to last year's
' last calendar week
If StartDays >= 4 Then
WeekNumber = Fix(VNumber) + 2
Else
WeekNumber = Fix(VNumber) + 1
End If
' Handle years whose last days will belong to coming year's first
' calendar week
If WeekNumber > 52 And ThurFlag = False Then WeekNumber = 1
' Handle years whose first days will belong to the last year's
' last calendar week
If WeekNumber = 0 Then
WeekNumber = WeekNumber(DateSerial(Year(InDate) - 1, 12, 31))
End If
ExitHere:
Exit Function
HandleErr:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description,
vbCritical, "Form_frmBfPickADate.WeekNumber"
End Select
End Function
'================================================
'Function obtained from Microsoft Knowledge Base
'Q200299
'Called by Weeknumber()
'================================================
Function Days(DayNo As Date) As Integer
On Error GoTo HandleErr
Days = DayNo - DateSerial(Year(DayNo), 1, 0)
ExitHere:
Exit Function
HandleErr:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description,
vbCritical, "Form_frmBfPickADate.Days"
End Select
End Function
