Public Function AddWorkingDays(ByVal dteStartDate As Date, _
ByVal intDays As Integer) As Date
Dim dteTemp As Date
dteTemp = dteStartDate
Do While intDays <> 0
Select Case WeekDay(dteTemp)
Case Is = 1, 7
Case Else
Select Case dteTemp
Case Is = DateSerial(Year(dteTemp), 1, 1), _
DateOfEaster(Year(dteTemp)) - 2, _
DateOfEaster(Year(dteTemp)) + 1, _
GetBankHoliday(DateSerial(Year(dteTemp), 5, 1)), _
GetBankHoliday(DateSerial(Year(dteTemp), 5, 25)), _
GetBankHoliday(DateSerial(Year(dteTemp), 8, 25)), _
DateSerial(Year(dteTemp), 12, 25), _
DateSerial(Year(dteTemp), 12, 26)
Case Else
intDays = intDays - 1
End Select
End Select
dteTemp = dteTemp + 1
Loop
AddWorkingDays = dteTemp - 1
End Function
Public Function DateOfEaster(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
DateOfEaster = DateSerial(intYear, 4, intQuote - 31)
Else
DateOfEaster = DateSerial(intYear, 3, intQuote)
End If
End Function
Public Function GetBankHoliday(ByRef dteBankHoliday As Date) As Date
Dim intCounter As Integer
For intCounter = 0 To 6
If WeekDay(dteBankHoliday + intCounter) = 2 Then
dteBankHoliday = dteBankHoliday + intCounter
Exit For
End If
Next intCounter
GetBankHoliday = dteBankHoliday
End Function