Public Function CreateWeekTable(ByVal BeginDate As Date, ByVal Years As Integer)
'***************************************************
'Enter as BeginDate the first day of the year (1/1/YYYY), and a table
'will be made listing the week ranges for the next 4 years.
'***************************************************
Dim db As DAO.Database
Dim tbl As TableDef
Dim xxx As Integer
xxx = 0 'Create table unless xxx = 1
Dim varStart As Date
Dim varFinish As Date
Dim varWeekNumber As Integer
Dim varYear As String
Set db = CurrentDb
'***************************************************
'Search for existing table, and clear records if available
'***************************************************
For Each tbl In db.TableDefs
If tbl.Name = "tblWeekRanges" Then
db.Execute "DELETE * FROM tblWeekRanges", dbFailOnError
xxx = 1 'Do not create table
End If
Next tbl
'***************************************************
'If not present, create table.
'***************************************************
If xxx = 0 Then
Dim SQL As String
SQL = "CREATE TABLE tblWeekRanges (Year TEXT, WeekNo INT, WkStart DATE, WkFinish DATE);"
DoCmd.SetWarnings (WarningsOff)
DoCmd.RunSQL SQL
DoCmd.SetWarnings (WarningsOff)
End If
'***************************************************
'Set initial values.
'***************************************************
'Make BeginDate the beginning of the week
If DatePart("w", BeginDate) > 1 Then
varStart = DateAdd("d", -DatePart("w", BeginDate) + 1, BeginDate)
Else
varStart = BeginDate
End If
varFinish = DateAdd("d", 6, varStart)
varWeekNumber = 1
If DatePart("yyyy", varStart) <> DatePart("yyyy", varFinish) Then
varYear = DatePart("yyyy", varFinish)
Else
varYear = DatePart("yyyy", varStart)
End If
'***************************************************
'Run first entry
'***************************************************
SQL = "INSERT INTO tblWeekRanges (Year, WeekNo, WkStart, WkFinish) VALUES ( " & _
"'" & varYear & "', '" & varWeekNumber & "', '" & varStart & "', '" & varFinish & "');"
DoCmd.SetWarnings (WarningsOff)
DoCmd.RunSQL SQL
DoCmd.SetWarnings (WarningsOff)
'***************************************************
'Enter some period of years...
'***************************************************
For yar = 0 To ((Years * 52) - 1) '# of years * 52weeks, minus the first entry above.
varStart = DateAdd("d", 1, varFinish)
varFinish = DateAdd("d", 6, varStart)
If varWeekNumber >= 52 Then
If DatePart("yyyy", varStart) = DatePart("yyyy", varFinish) And DatePart("m", varFinish) <> 1 Then
varWeekNumber = varWeekNumber + 1
Else
varWeekNumber = 1
End If
Else
varWeekNumber = varWeekNumber + 1
End If
If DatePart("yyyy", varStart) <> DatePart("yyyy", varFinish) Then
varYear = DatePart("yyyy", varFinish)
Else
varYear = DatePart("yyyy", varStart)
End If
SQL = "INSERT INTO tblWeekRanges (Year, WeekNo, WkStart, WkFinish) VALUES ( " & _
"'" & varYear & "', '" & varWeekNumber & "', '" & varStart & "', '" & varFinish & "');"
DoCmd.SetWarnings (WarningsOff)
DoCmd.RunSQL SQL
DoCmd.SetWarnings (WarningsOff)
Next yar
CreateWeekTable = "Success!"
End Function
