No matter how much you’d like VBA date/time values to be able to track elapsed time, they’re not built that way. As designed, VBA date/time values store a particular point in time, not a span of time, and there’s no way to store more than 24 hours in a given date/time variable. If you want to work with elapsed times, you’ll generally have to do some conversion work, storing the elapsed times in a numeric datatype and converting them back to a formatted output for display. Other elapsed time issues simply return an integer value indicating the number of elapsed units (year, days, months) between two dates.
This section covers several standard issues when dealing with elapsed times, including these topics:
Finding Workdays between Two Dates
Many applications require you to calculate the number of days between two dates (and you can simply use DateDiff or subtract the first date value from the second, if that’s all you need). In addition, many business applications need to know the number of workdays between two dates, and that’s a bit more complex. The function in this section, dhCountWorkdays, uses the code presented previously (see the section “Working with Workdays”) to skip holidays and weekends. Listing 2.20 shows the entire function.
Listing 2.20: Count the Number of Workdays between Two Dates
Function dhCountWorkdays(ByVal dtmStart As Date, _
ByVal dtmEnd As Date, _
Optional rst As Recordset = Nothing, _
Optional strField As String = "") _
As Integer
Dim intDays As Integer
Dim dtmTemp As Date
Dim intSubtract As Integer
' Swap the dates if necessary.
If dtmEnd < dtmStart Then
dtmTemp = dtmStart
dtmStart = dtmEnd
dtmEnd = dtmTemp
End If
' Get the start and end dates to be weekdays.
dtmStart = SkipHolidays(rst, strField, dtmStart, 1)
dtmEnd = SkipHolidays(rst, strField, dtmEnd, -1)
If dtmStart > dtmEnd Then
' Sorry, no workdays to be had. Just return 0.
dhCountWorkDays = 0
Else
intDays = dtmEnd - dtmStart + 1
' Subtract off weekend days. Do this by figuring out
' how many calendar weeks there are between the dates
' and multiplying the difference by two (since there
' are two weekend days for each week). That is, if the
' difference is 0, the two days are in the same week.
' If the difference is 1, then you have two weekend days.
intSubtract = (DateDiff("ww", dtmStart, dtmEnd) * 2)
' The answer, finally, is all the weekdays, minus any
' holidays found in the table.
' If rst is Nothing, this call won't subtract any dates.
intSubtract = intSubtract + CountHolidays(rst, _
strField, dtmStart, dtmEnd)
dhCountWorkdays = intDays - intSubtract
End If
End Function
To call dhCountWorkdays, pass it two dates (the starting and ending dates). In addition, if you want to take holidays into account, pass it a reference to an open recordset and the name of the field within the recordset containing the holiday date information. For more information on working with this type of function, see the section “Working with Workdays” earlier in this chapter. Unlike the functions presented there, however, this one requires a bit of effort to find the right answer.
There are, of course, many ways to solve this problem. The solution we came up with takes these steps:
dtmStart = SkipHolidays(rst, strField, dtmStart, 1)
dtmEnd = SkipHolidays(rst, strField, dtmEnd, -1)
If dtmStart > dtmEnd Then
' Sorry, no workdays to be had. Just return 0.
dhCountWorkdays = 0
intDays = dtmEnd - dtmStart + 1
Now for the tricky part, the final three steps:
intSubtract = (DateDiff("ww", dtmStart, dtmEnd) * 2)
intSubtract = intSubtract + CountHolidays(rst, strField, _
dtmStart, dtmEnd)
dhCountWorkdays = intDays - intSubtract
To work with these procedures, you might write a test routine like the one shown in Listing 2.21. This procedure makes these assumptions:
Listing 2.21: Test Procedure for dhCountWorkdays
Sub TestCountWorkdays()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Set db = DAO.DBEngine.OpenDatabase("Holidays.MDB")
Set rst = db.OpenRecordset("tblHolidays", _
DAO.dbOpenDynaset)
Debug.Print dhCountWorkdays(#12/27/96#, #1/2/97#, _
rst, "Date")
Debug.Print dhCountWorkdays(#12/27/96#, #1/2/97#)
End Sub