I am trying to work out on a form how to calculate how many working days are subtracted forma date. On a form I have a date of an event and on a subform I have a combobox that the user selects from a number of options what kind of communications are needed for this event. For instance I have one that will select an invite (1) which will notify the user that an invite needs to be sent 7 days before the event. This then fills in a form field showing the date when it needs to be sent. I have this working correctly as below:
Code:
If Me.cmboCommunicationName.Value = 1 Then
Me.CommunicationDueDate = DateAdd("d", -7, Forms![frmMainNavigation]![NavigationSubform].Form![EventStartDayDate])
But I need to work out the date taking into account weekends (and better still public holidays as well) so that the communication is not sent out on a weekend as if the event fell on a Tuesday and as one of the options sends out a communication 3 days before it would be sent out on a saturday and if the recipient didn't get their email until they came into work they wouldn't get it until monday the day before the event!
I have read quite a bit about this and realise that I have to put a function into a module to work out the weekdays. But I have no idea how to go about putting the function into the code. I have found some code online that will work it out as belowthat I have adapted for the UK holidays this year:
Code:
Option Compare Database
Option Explicit
Const vbNewYear = "01/01/"
Const vbChristmasDay = "25/12/"
Const vbBoxingDay = "26/12/"
Public Function DaysInMonth(ByVal dteMonth As Date) As Integer
Dim dteStart As Date
Dim dteEnd As Date
dteStart = DateSerial(Year(dteMonth), Month(dteMonth), 1)
dteEnd = DateAdd("m", 1, dteStart) - 1
DaysInMonth = CalculateDays(dteStart, dteEnd, True)
End Function
Public Function CalculateDays(ByVal dteStart As Date, _
ByVal dteEnd As Date, Optional Include As Boolean) As Long
Dim dteTemp As Date
Dim lngDays As Long
dteTemp = dteStart
Do While dteTemp <> dteEnd
If Not IsHoliday(dteTemp) Then
Select Case Weekday(dteTemp)
Case vbMonday, vbTuesday, vbWednesday, vbThursday, vbFriday
lngDays = lngDays + 1
End Select
End If
dteTemp = DateAdd("d", 1, dteTemp)
Loop
If Include = True Then lngDays = lngDays + 1
CalculateDays = lngDays
End Function
Public Function IsHoliday(ByVal dteTemp As Date) As Boolean
On Error GoTo Err_IsHoliday
Dim intYear As Integer
intYear = Year(dteTemp)
If DCount("HolidayID", "tblHolidays", "HolidayDate = #" & dteTemp & "#") > 0 Then
IsHoliday = True
Exit Function
Else
Select Case dteTemp
Case Is = CDate(vbNewYear & intYear)
IsHoliday = True
Exit Function
Case Is = GoodFriday(intYear)
IsHoliday = True
Exit Function
Case Is = EasterMonday(intYear)
IsHoliday = True
Exit Function
Case Is = EarlySpringBankHoliday(intYear)
IsHoliday = True
Exit Function
Case Is = LateSpringBankHoliday(intYear)
IsHoliday = True
Exit Function
Case Is = SummerBankHoliday(intYear)
IsHoliday = True
Exit Function
Case Is = CDate(vbChristmasDay & intYear)
IsHoliday = True
Exit Function
Case Is = CDate(vbBoxingDay & intYear)
IsHoliday = True
Exit Function
Case Else
IsHoliday = False
End Select
End If
Exit_IsHoliday:
Exit Function
Err_IsHoliday:
IsHoliday = False
Resume Exit_IsHoliday
End Function
Private Function EarlySpringBankHoliday(ByVal intYear As Integer) As Date
Dim dteStart As Date, intWeekDay As Integer
dteStart = DateSerial(intYear, 5, 2)
intWeekDay = Weekday(dteStart)
dteStart = DateAdd("d", IIf(2 < intWeekDay, 7 - intWeekDay + 2, 2 - intWeekDay), dteStart)
EarlySpringBankHoliday = dteStart
End Function
Private Function LateSpringBankHoliday(ByVal intYear As Integer) As Date
Dim dteStart As Date, intWeekDay As Integer
dteStart = DateSerial(intYear, 5, 30)
intWeekDay = Weekday(dteStart)
dteStart = DateAdd("d", IIf(2 < intWeekDay, 7 - intWeekDay + 2, 2 - intWeekDay), dteStart) - 7
LateSpringBankHoliday = dteStart
End Function
Private Function GoodFriday(ByVal intYear As Integer) As Date
GoodFriday = DateAdd("d", -2, Easter(intYear))
End Function
Private Function Easter(ByVal intYear As Integer) As Date
Dim intDominical As Integer, intEpact As Integer, intQuote As Integer
intDominical = 225 - (11 * (intYear Mod 19))
If intDominical > 50 Then
While intDominical > 50
intDominical = intDominical - 30
Wend
End If
If intDominical > 48 Then intDominical = intDominical - 1
intEpact = (intYear + Int(intYear / 4) + intDominical + 1) Mod 7
intQuote = intDominical + 7 - intEpact
If intQuote > 31 Then
Easter = DateSerial(intYear, 4, intQuote - 31)
Else
Easter = DateSerial(intYear, 3, intQuote)
End If
End Function
Private Function EasterMonday(ByVal intYear As Integer) As Date
EasterMonday = DateAdd("d", -2, Easter(intYear))
End Function
Private Function SummerBankHoliday(ByVal intYear As Integer) As Date
Dim dteStart As Date, intWeekDay As Integer
dteStart = DateSerial(intYear, 8, 29)
intWeekDay = Weekday(dteStart)
dteStart = DateAdd("d", IIf(2 < intWeekDay, 7 - intWeekDay + 2, 2 - intWeekDay), dteStart) - 7
SummerBankHoliday = dteStart
End Function
But I have no idea what to do with this as it seems to my limited knowledge to have a number of functions in it and have no idea what to do next. I imagine it is something along the lines of:
Code:
If Me.cmboCommunicationName.Value = 1 Then
Me.CommunicationDueDate = CalculateDays("#Forms![frmMainNavigation]![NavigationSubform].Form![EventStartDayDate]#", 7, False)
End If
But I have no idea at all.
Can anyone point me where to look for help on this please or an easy way of doing this. Thank you all.