Public Function GetDaysEFH(vDateStart, vDateEnd) As Integer ' v002
' Days between dates - "... EFH" = "Excluding Fridays And Holidays"
' https://www.access-programmers.co.uk/forums/threads/help-in-access-issue-calculated-field-for-leave-system.324595/#post-1842392
'---------------------------------------------------------------------------------------------------
'For tests:
' ?GetDaysEFH ("01.01.2022", "15.01.2022") = 12 (15 - 2 (Frydays) -1 (Holiday "New Year"))
'---------------------------------------------------------------------------------------------------
Const iFirstDayOfWeek% = 2 'vbMonday = 2; vbSunday = 1
'Holidays table
Const sTableHolidays$ = "Hoidays" 'Table name
Const sFldHolidaysStart$ = "[Holi Start]" 'Field name
Const sFldHolidaysQty$ = "Days" 'Field name
'Others:
Dim sVal$, iVal%, iDays%, iDaysLeft%, iDaysOff%, dDate As Date, vVal
'---------------------------------------------------------------------------------------------------
On Error GoTo GetDaysEFH_Err
If IsDate(vDateStart) = False Then GoTo GetDaysEFH_End
If IsDate(vDateEnd) = False Then GoTo GetDaysEFH_End
iDays = DateDiff("d", vDateStart, vDateEnd)
'Debug.Print "Total Days : " & iDays + 1
For iVal = 0 To iDays
dDate = DateAdd("d", iVal, vDateStart)
iDaysLeft = iDays - iVal
sVal = sFldHolidaysStart & " = " & Format$(dDate, "\#mm\/dd\/yyyy\#")
vVal = DLookup(sFldHolidaysQty, sTableHolidays, sVal)
If vVal > 0 Then
If vVal > iDaysLeft Then vVal = iDaysLeft
iDaysOff = iDaysOff + vVal
iVal = iVal + vVal
'Debug.Print "Holiday : " & dDate & _
" Days: + " & vVal & " Total Days Off: " & iDaysOff
Else
If Weekday(dDate, iFirstDayOfWeek) = 5 Then
iDaysOff = iDaysOff + 1
'Debug.Print "Friday : " & dDate & _
" Days: + 1" & " Total Days Off: " & iDaysOff 'Friday
End If
End If
'Debug.Print "dDate = " & dDate & _
" - iDaysLeft = " & iDaysLeft & " Total Days Off: " & iDaysOff
Next iVal
GetDaysEFH = iDays + 1 - iDaysOff
GetDaysEFH_End:
Exit Function
GetDaysEFH_Err:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Function : " & _
"GetDaysEFH - DataTransform.", vbCritical, "Error!"
'Debug.Print "GetDaysEFH_Line: " & Erl & "."
Err.Clear
Resume GetDaysEFH_End
End Function
