Weeknummer in Lotusscript

Voor een applicatie had ik een weeknummer functie nodig. Format(Now,”ww”) werkt niet goed voor jaren waar een week 53 bestaat.
Een iets aangepaste script van de MSDN site werkt echter prima.
Invoer Is een datum, uitvoer Is een tekst met het jaar en het weeknummer waarin de invoerdatum valt.

Function getWeekNumber(InDate As NotesDateTime) As String
On Error GoTo ErrorHandler
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
Dim tmpDate As NotesDateTime
Dim tmpWeek As Integer
Set tmpDate = New NotesDateTime(DateSerial(Year(inDate.LSLocalTime), 1, 0))
DayNo = InDate.TimeDifference(tmpDate)/60/60/24
StartDay = Weekday(DateSerial(Year(InDate.LSLocalTime), 1, 1)) – 1
StopDay = Weekday(DateSerial(Year(InDate.LSLocalTime ), 12, 31)) – 1
StartDays = 7 – (StartDay – 1) ‘Number of days for the first calendar week
StopDays = 7 – (StopDay – 1) ‘Number of days for last calendar week
If StartDay = 4 Or StopDay = 4 Then ThurFlag = True Else ThurFlag = False ‘Test to see if the year has 53 weeks
VNumber = (DayNo – StartDays – 4) / 7 ‘If first week has 4 or more days, it will be calendar week 1 otherwise it will belong to last year’s last calendar week
If StartDays >= 4 Then
tmpWeek = Fix(VNumber) + 2
Else
tmpWeek = Fix(VNumber) + 1
End If
If tmpWeek > 52 And ThurFlag = False Then tmpWeek = 1 ‘Handle years whose last days will belong to coming year’s first calendar week
If tmpWeek = 0 Then ‘Handle years whose first days will belong to the last year’s last calendar week
Set tmpDate = New NotesDateTime(DateSerial(Year(InDate.LSLocalTime ) – 1, 12, 31))
getWeekNumber = getWeekNumber(tmpDate) ‘Recursive loop
Else
getWeekNumber = Format(inDate.LSLocalTime,”yyyy”) & ” week ” & CStr(tmpWeek)
End If
Exit Function
ErrorHandler:
MsgBox GetThreadInfo(1) & ” ” & Error & ” (” & Err & “) op regel ” & Erl & “.”
Exit Function
Resume Next
End Function

Geplaatst in Lotusscript, Ontwikkeling en getagd met , .