An easy way to create a table of sequential dates is to serially fill a
column in Excel and import it into Access. Or you can use the following
function. Just paste it into a standard module. To use it you'd first need
to create a reference to the Microsoft ADO Extensions for DDL and Security
object library from the Tools|References menu item on the VBA menu bar.
Public Function MakeCalendar(strTable As String, _
dtmStart As Date, _
dtmEnd As Date, _
ParamArray varDays() As Variant)
' Accepts: Name of calendar table to be created: String.
' Start date for calendar: DateTime.
' End date for calendar: DateTime.
' Days of week to be included in calendar
' as value list, e,g 2,3,4,5,6 for Mon-Fri
' (use 0 to include all days of week)
Dim cmd As ADODB.Command
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim strSQL As String
Dim dtmDate As Date
Dim varDay As Variant
Dim lngDayNum As Long
Set cmd = New ADODB.Command
cmd.ActiveConnection = CurrentProject.Connection
cmd.CommandType = adCmdText
Set cat = New Catalog
cat.ActiveConnection = CurrentProject.Connection
' does table exist? If so get user confirmation to delete it
On Error Resume Next
Set tbl = cat(strTable)
If Err = 0 Then
If MsgBox("Replace existing table: " & _
strTable & "?", vbYesNo + vbQuestion, _
"Delete Table?") = vbYes Then
strSQL = "DROP TABLE " & strTable
cmd.CommandText = strSQL
cmd.Execute
Else
Set cmd = Nothing
Exit Function
End If
End If
On Error GoTo 0
' create new table
strSQL = "CREATE TABLE " & strTable & _
"(calDate DATETIME, " & _
"CONSTRAINT PrimaryKey PRIMARY KEY (calDate))"
cmd.CommandText = strSQL
cmd.Execute
' refresh database window
Application.RefreshDatabaseWindow
' refresh catalog
cat.Tables.Refresh
' set validation rule for caldate column to prevent
' insertion of rows outside data range
Set tbl = cat(strTable)
tbl.Columns("caldate").Properties("Jet OLEDB:Column Validation Rule") = _
"BETWEEN #" & Format(dtmStart, "mm/dd/yyyy") & "# AND #" & _
Format(dtmEnd, "mm/dd/yyyy") & "#"
If varDays(0) = 0 Then
' fill table with all dates
For dtmDate = dtmStart To dtmEnd
lngDayNum = lngDayNum + 1
cmd.CommandText = strSQL
strSQL = "INSERT INTO " & strTable & "(calDate) " & _
"VALUES(#" & Format(dtmDate, "mm/dd/yyyy") & "#)"
cmd.CommandText = strSQL
cmd.Execute
Next dtmDate
Else
' fill table with dates of selected days of week only
For dtmDate = dtmStart To dtmEnd
For Each varDay In varDays()
If Weekday(dtmDate) = varDay Then
lngDayNum = lngDayNum + 1
cmd.CommandText = strSQL
strSQL = "INSERT INTO " & strTable & "(calDate) " & _
"VALUES(#" & Format(dtmDate, "mm/dd/yyyy") & "#)"
cmd.CommandText = strSQL
cmd.Execute
End If
Next varDay
Next dtmDate
End If
Set cmd = Nothing
End Function
The function allows you to create a table with a date column caldate
covering any date range, and to select which days of the week you wish to
include. It also sets a validation rule to prevent dates outside the date
range being entered, though it would not prevent weekend dates being entered
should you create the table with only dates for Monday-Friday each week say.
To create a table called SchoolCalendar with dates for Mondays to Fridays
only from 1 Sept 2006 to 30 June 2007 for instance you'd call it with:
MakeCalendar "SchoolCalendar",#09/01/2006#,#06/30/2007#,2,3,4,5,6
To include all days of the week use 0:
MakeCalendar "SchoolCalendar",#09/01/2006#,#06/30/2007#,0
Once you have the table of dates you can then open it in design view and add
any other fields as necessary. If you need to create a table covering
several non-contiguous date ranges use the function to create several
different tables and then append the rows from the others into one of them.
Ken Sheridan
Stafford, England
