Greetings all,
I am working on a small staff scheduling db based on Allen Browne's
Recurring events. See
http://allenbrowne.com/AppRecur.html.
I have added a work day function based on Arvin Meyer's function -
http://www.datastrat.com/Code/GetBusinessDay.txt.
It works fine if I add consecutive workdays, where the period frequency is
one. I cannot seem to modify the code where the period frequency is greater
than one. Meaning, I would like to be able to schedule staff Monday through
Friday every two weeks and not every week. Is this possible?
Instead of the built in Dateadd function, I am trying to write my own
function (and struggling). Here is the modified function:
Public Function DateRecur(strInterval As String, intDayAdd As Integer, _
dteStart As Date) As Date
On Error GoTo Error_Handler
'Adds/Subtracts the proper Business day skipping holidays and weekends
'Requires a table (tblHolidays) with a date field (HolidayDate)
'Arvin Meyer 05/26/98 revised 3/12/2002
'Dim rst As DAO.Recordset
'Dim DB As DAO.Database
'Dim strSQL As String
'Set DB = CurrentDb
'Set rst = DB.OpenRecordset("SELECT [HolidayDate] FROM tblHolidays",
dbOpenSnapshot)
Select Case strInterval
Case "dw"
'work days only (MTWRF)
If intDayAdd > 0 Then
Do While intDayAdd > 0
dteStart = dteStart + 1
'rst.FindFirst "[HolidayDate] = #" & dteStart & "#"
If Weekday(dteStart) <> 1 And Weekday(dteStart) <> 7 Then
'If rst.NoMatch Then intDayAdd = intDayAdd - 1
intDayAdd = intDayAdd - 1
End If
Loop
End If
Case Else
'typical dateadd - d,ww,m,q,yyyy,
DateRecur = DateAdd(strInterval, intDayAdd, dteStart)
End Select
Exit_Here:
‘rst.Close
‘Set rst = Nothing
‘Set DB = Nothing
Exit Function
Error_Handler:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Here
End Function
I hope this makes sense and thanks in advance,
george
Similar Threads
