Calculate date ranges excluding weekends and company holidays

To use this script, you need a form with the fields StartDate, and Length for the time frame.

This Content Component encountered an error

After trying a few of the scripts on this site and discovering that none of them actually worked the way I wanted them to, I decided to write my own that actually went beyond the scope of one week. To use this script, you need a form with fields StartDate (Date/Time-Editable), Length (Number-Editable), EndDate (Date/Time-Computed when composed, default "") and Range (Text-Computed when composed, default ""). In addition you need a form...

named "Holiday | HOL" to create the holidays with a field named StartDate (Date/Time-Editable) for the date of the holiday. Create a document for each of the holidays. You also need a script library titled "Calculations" to hold the code.

'In the Globals\Options section of the form Option Public Option Declare Use "Calculations" 'In the QuerySave Event of form: Set s = New NotesSession Set db = s.CurrentDatabase Set doc = source.document If CalcEndDate(doc.StartDate(0),doc.Length(0)) Then Call doc.Save(False,False) Else Continue = False End If 'In the "Calculations" Script Library: 'Options: Option Public Option Declare %INCLUDE "lserr.lss" %INCLUDE "lsxbeerr.lss" %INCLUDE "lsxuierr.lss" 'Declarations: Dim s As NotesSession Dim db As NotesDatabase Dim dc As NotesdocumentCollection Function CalcEndDate(varStartDate_p As Variant, intLength_p As Integer) On Error Goto CalcEndDateErr CalcEndDate = True Dim ndtmEndDate As NotesDateTime Dim ndtmEndSaveDate As NotesDateTime Dim ndtmStartDate As NotesDateTime Dim ndrRange As NotesDateRange Dim intHolidays As Integer Dim intWeekend As Integer Dim intCounter As Integer Dim intStopFlag As Integer Dim intNewLength As Integer Dim intSaveLength As Integer Set ndtmEndDate = New NotesDateTime(varStartDate_p) Set ndrRange = s.CreateDateRange Call ndtmEndDate.AdjustDay(intLength_p - 1, True) intNewLength = intLength_p intSaveLength = intLength_p intStopFlag = 0 Do Until intStopFlag = 1 intHolidays = 0 intWeekend = 0 intSaveLength = intNewLength Set ndtmEndSaveDate = New NotesDateTime(varStartDate_p) Set ndtmStartDate = New NotesDateTime(varStartDate_p) Call ndtmEndSaveDate.AdjustDay(intNewLength) intHolidays = CheckHolidays(ndtmStartDate, ndtmEndSaveDate) intNewLength = intLength_p + intHolidays intWeekend = CheckWeekends(ndtmStartDate, intNewLength) intNewLength = intLength_p + intWeekend + intHolidays If intSaveLength = intNewLength Then Call ndtmEndDate.AdjustDay(intNewLength-intLength_p,True) intStopFlag = 1 End If Loop Set ndtmStartDate = New NotesDateTime(varStartDate_p) Set ndrRange.StartDateTime = ndtmStartDate Set ndrRange.EndDateTime = ndtmEndDate doc.Range = ndrRange.Text doc.EndDate = ndtmEndDate.DateOnly CalcEndDateExit: Exit Function CalcEndDateErr: CalcEndDate = False Messagebox "Error Number " & Err & " occured at line number " & Erl & " due to: " & Error(Err) Resume CalCEndDateExit End Function Function CheckHolidays(varStartDate_p As Variant, varEndDate_p As Variant) As Integer CheckHolidays = 0 Dim strSearch As String Dim holdoc As NotesDocument Dim intcount As Integer Dim varHolidays() As Variant Dim ndtmValue As NotesDateTime Dim strDate As String Dim ndtmCheck As New NotesDateTime(varStartDate_p.DateOnly) Dim ndtmEnd As New NotesDateTime(varEndDate_p.DateOnly) Dim ndtmNewEnd As New NotesDateTime(varEndDate_p.DateOnly) strSearch = {((Form="Holiday")|(Form="HOL"))} Set dc = db.Search(strSearch,Nothing,0) Redim varHolidays(dc.Count-1) For intcount = 1 To dc.Count Set holdoc = dc.GetNthDocument(intCount) varHolidays(intCount-1) = holdoc.StartDate(0) Next For intCount = 0 To Ubound(varHolidays) Set ndtmCheck = New NotesDateTime(varStartDate_p.DateOnly) strDate = varHolidays(intCount) Set ndtmValue = New NotesDateTime(strDate) Do Until ndtmCheck.DateOnly = ndtmNewEnd.DateOnly If ndtmCheck.DateOnly = ndtmValue.DateOnly Then CheckHolidays = CheckHolidays + 1 Call ndtmNewEnd.AdjustDay(1, True) Call ndtmCheck.AdjustDay(1, True) Else Call ndtmCheck.AdjustDay(1, True) End If Loop Next End Function Function CheckWeekends(varStartDate_p As Variant, intLength_p As Integer) As Integer Dim strSaveDate As String Dim intNewLength As Integer Dim intSaveLength As Integer Dim intCount As Integer Dim ndtmDate As NotesDateTime Dim intDone As Integer Set ndtmDate = varStartDate_p intDone = 0 intNewLength = intLength_p strSaveDate = varStartDate_p.DateOnly Do Until intDone = 1 CheckWeekends = 0 intSaveLength = intNewLength For intCount = 1 To intNewLength If Weekday(ndtmDate.DateOnly) = 1 Or Weekday(ndtmDate.DateOnly) = 7 Then Checkweekends = CheckWeekends + 1 intNewLength = intLength_p + CheckWeekends End If Call ndtmDate.AdjustDay(1,True) Next If intNewLength = intLength_p Then intDone = 1 Else If intSaveLength = intNewLength Then intDone = 1 Else Set ndtmDate = New NotesDateTime(strSaveDate) End If End If Loop End Function
This was first published in July 2001

Dig deeper on Domino Resources - Part 2

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchWindowsServer

Search400

  • iSeries tutorials

    Search400.com's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...

SearchEnterpriseLinux

SearchDataCenter

SearchExchange

SearchContentManagement

Close