for i = 0 to 4
if i = 0 then
arrRange(i,0) = 1
if nWeek = 6 then
arrRange(i,1) = arrRange(i,0)
else
arrRange(i,1) = arrRange(i,0) + 6 - nWeek
end if
else
arrRange(i,0) = arrRange(i-1,1)+1
arrRange(i,1) = arrRange(i,0) + 6
end if
next
Dim currWeek
for i = 0 to 4
if arrRange(i,0) <= strDay and strDay <= arrRange(i,1) then
currWeek = i + 1
end if
next
if currWeek = "" then
currWeek = 0
end if
GetWeek = currWeek
End Function
'Test
Dim nWeek,cDate
cDate = Now()
nWeek = GetWeek(cDate)