It can be done with a function, and I've written one myself which does this,
taking account of differing public holidays in the different UK countries,
but another approach, which many would argue is better in a relational
database, is to do it by means of a Calendar table, which is simply a table
of sequential dates over a given period. You can either exclude weekends
from the count or you can exclude them from the table itself. I've created a
function which does both. To create a calendar of just weekdays from 1
January 2005 to 31 December 2115 say you'd call the function with:
Make calendar "WorkdaysCalendar",#01/01/2005#,12/31/2115#, 2,3,4,5,6
You just need to call this once from the debug window (aka immediate pane)
You can then return the count in a query. say you have a table MyTable with
columns StarrtDate and EndDate then you could use:
SELECT StartDate, EndDate
(SELECT COUNT(*)
FROM WorkDaysCalendar
WHERE CalDate BETWEEN
MYTable.StartDate AND MyTable.EndDate) AS CountOfWorkDays
FROM MyTable;
You can of course include other fields from MyTable in the query's SELECT
clause. This query would not be updatable due to the use of the SQL COUNT
operator. For an updatable table use the VBA DCount function:
SELECT StartDate, EndDate
DCount("*",WorkdaysCalendar", "CalDate Between #" &
Format([StartDate],"mm/dd/yyyy") & "# And #" &
Format([EndDate],"mm/dd/yyyy") & "#") AS CountOfWorkDays
FROM MyTable;
To allow for public holidays you can just delete the rows for the relevant
dates from WorkDaysCalendar so that they are not counted.
The code for the function is:
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
Ken Sheridan
Stafford, England
