|
Public Function NetWorkDays(StartDate As Date, EndDate As Date) As Integer
Dim dbs As Database
Dim rstHolidays As Recordset
Dim rstAddiWorkingDay As Recordset
Dim Idx As Long
Dim MyDate As Date
Dim NumDays As Long
Dim strCriteria As String
Dim NumSgn As String * 1
Set dbs = CurrentDb
Set rstHolidays = dbs.OpenRecordset("Holidays", dbOpenDynaset)
Set rstAddiWorkingDay = dbs.OpenRecordset("AdditionalWorkingDay", dbOpenDynaset)
NumSgn = Chr(35)
If EndDate >= StartDate Then
MyDate = Format(StartDate, "Short Date")
For Idx = CLng(StartDate) To CLng(EndDate)
Select Case (Weekday(MyDate))
Case Is = 1 'Sunday
strCriteria = "[AdditionalWorkingDay] = " & NumSgn & Format$(MyDate, "yyyy-mm-dd") & NumSgn
rstAddiWorkingDay.FindFirst strCriteria
If (rstHolidays.NoMatch) Then
Else
NumDays = NumDays + 1
End If
Case Is = 7 'Saturday
strCriteria = "[AdditionalWorkingDay] = " & NumSgn & Format$(MyDate, "yyyy-mm-dd") & NumSgn
rstAddiWorkingDay.FindFirst strCriteria
If (rstAddiWorkingDay.NoMatch) Then
Else
NumDays = NumDays + 1
End If
Case Else 'Normal Workday
strCriteria = "[HolidayDate] = " & NumSgn & Format$(MyDate, "yyyy-mm-dd") & NumSgn
rstHolidays.FindFirst strCriteria
If (rstAddiWorkingDay.NoMatch) Then
NumDays = NumDays + 1
Else
End If
End Select
MyDate = DateAdd("d", 1, MyDate)
Next Idx
NetWorkDays = NumDays - 1
ElseIf EndDate < StartDate Then
MyDate = Format(EndDate, "Short Date")
For Idx = CLng(EndDate) To CLng(StartDate)
Select Case (Weekday(MyDate))
Case Is = 1 'Sunday
strCriteria = "[AdditionalWorkingDay] = " & NumSgn & Format$(MyDate, "yyyy-mm-dd") & NumSgn
rstAddiWorkingDay.FindFirst strCriteria
If (rstAddiWorkingDay.NoMatch) Then
Else
NumDays = NumDays + 1
End If
Case Is = 7 'Saturday
strCriteria = "[AdditionalWorkingDay] = " & NumSgn & Format$(MyDate, "yyyy-mm-dd") & NumSgn
rstAddiWorkingDay.FindFirst strCriteria
If (rstAddiWorkingDay.NoMatch) Then
Else
NumDays = NumDays + 1
End If
Case Else 'Normal Workday
strCriteria = "[HolidayDate] = " & NumSgn & Format$(MyDate, "yyyy-mm-dd") & NumSgn
rstHolidays.FindFirst strCriteria
If (rstHolidays.NoMatch) Then
NumDays = NumDays + 1
Else
End If
End Select
MyDate = DateAdd("d", 1, MyDate)
Next Idx
NetWorkDays = -NumDays + 1
End If
rstHolidays.Close
rstAddiWorkingDay.Close
End Function |
|