Sample Code from Total Visual SourceBook

The modDateTime module provides extensive code to deal with date and time values. This module contains code that enhances the basic VBA/VB6 date functions with code for adding and subtracting dates, handling weekdays, finding the next or previous day, checking for leap years, determining ages, calculating differences between dates/times, and more.

This module includes 48 procedures:

Examples of three procedures are provided here:

• WaitForTime to wait for a specific time in the future
• WaitSeconds to wait a certain number of seconds
• AgeYears to calculate age based on a birth date
• AddWeekdays to add weekdays (not weekend days) to a date

The declarations section includes comments about the module and module level variables and declarations. In this example, we have one declare statement. Notice that our browser shows the code with color syntax highlighting similar to your VBA/VB6 IDE:

' Copyright (c) FMS, Inc. www.fmsinc.com
' Licensed to owners of Total Visual SourceBook
'
' Class       : modDateTime
' Description : Code for working with date and times
'
' Visual Basic provides many useful functions for dealing with date and time values. 
' This module contains code that enhances these functions, with code for adding and subtracting 
' dates, handling weekdays, finding the next or previous day, checking for leap years, 
' determining ages, calculating differences between dates/times, and more.
' Source : Total Visual SourceBook

Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)

A comment line describes each procedure, each parameter is defined, and error handling exists:

Public Sub WaitForTime(datDate As Date)
  ' Comments: Waits until the specified date and time
  ' Params  : datDate         Date/time to wait for
  ' Source  : Total Visual SourceBook

  On Error GoTo PROC_ERR

  Do
    ' Yield to other programs (better than using DoEvents which eats up all the CPU cycles)
    Sleep 100
    DoEvents
  Loop Until Now >= datDate

PROC_EXIT:
  Exit Sub

PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "modDateTime.WaitForTime"
  Resume PROC_EXIT
End Sub

Public Sub WaitSeconds(intSeconds As Integer)
  ' Comments: Waits for a specified number of seconds
  ' Params  : intSeconds      Number of seconds to wait
  ' Source  : Total Visual SourceBook
  
  On Error GoTo PROC_ERR

  Dim datTime As Date

  datTime = DateAdd("s", intSeconds, Now)

  Do
    ' Yield to other programs (better than using DoEvents which eats up all the CPU cycles)
    Sleep 100
    DoEvents
  Loop Until Now >= datTime

PROC_EXIT:
  Exit Sub

PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "modDateTime.WaitSeconds"
  Resume PROC_EXIT
End Sub

For functions, the comments include a description of the return value:

Public Function AgeYears(ByVal datBirthDate As Date) As Integer
  ' Comments: Returns the age in years
  ' Params  : datBirthDate    Date to check
  ' Returns : Number of years
  ' Source  : Total Visual SourceBook
  
  On Error GoTo PROC_ERR

  Dim intYears As Integer

  intYears = Year(Now) - Year(datBirthDate)

  If DateSerial(Year(Now), Month(datBirthDate), Day(datBirthDate)) > Now Then
    ' Subtract a year if birthday hasn't arrived this year
    intYears = intYears - 1
  End If

  AgeYears = intYears

PROC_EXIT:
  Exit Function

PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "modDateTime.AgeYears"
  Resume PROC_EXIT
End Function

Adding non-weekend dates is a common need:

Public Function AddWeekdays(datDateIn As Date, intDays As Integer) As Date
  ' Comments: Add or subtract a number of weekdays to a date.
  '           Weekend dates are not counted in adding/subtracting days.
  ' Params  : datDateIn       Starting date
  '           intDays         Number of days to add (negative to subtract)
  ' Returns : Original date plus the number of weekdays added
  ' Source  : Total Visual SourceBook
  
  On Error GoTo PROC_ERR

  Dim intCounter As Integer
  Dim intDirection As Integer
  Dim datNewDate As Date
  Dim lngWeeks As Long
  Dim intDaysLeft As Integer

  datNewDate = datDateIn

  If intDays > 0 Then
    intDirection = 1
  Else
    intDirection = -1
  End If
  lngWeeks = Fix(Abs(intDays) / 5)

  If lngWeeks > 0 Then
    datNewDate = datNewDate + lngWeeks * 7 * intDirection
  End If

  intDaysLeft = Abs(intDays) - lngWeeks * 5

  For intCounter = 1 To intDaysLeft
    datNewDate = datNewDate + 1 * intDirection
    If intDirection > 0 Then
      ' Increment date
      If Weekday(datNewDate) = 7 Then
        datNewDate = datNewDate + 2
      End If
    Else
      ' Decrement date
      If Weekday(datNewDate) = 1 Then
        datNewDate = datNewDate - 2
      End If
    End If
  Next intCounter

  AddWeekdays = datNewDate

PROC_EXIT:
  Exit Function

PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "modDateTime.AddWeekdays"
  Resume PROC_EXIT
End Function

Total Visual SourceBook also include two modules to perform real business day math where a list of holidays is kept either in a table or file. By using the list of holidays you specify, you can take into account weekdays that shouldn't be counted because your organization is closed. The Business Day routines let you:

• Calculate the number of business days between two dates
• Add or subtract a certain number of business days to a date
• Count the number of business days in a month
• See if a specific day is a business day and if not, move backward or forward to the next business day
• Calculate holidays for national holidays (e.g. the holiday for July 4th if it falls on a weekend)
• First or last business day of a week or month