Code: Option Explicit
'
' Takes the start date of a call and the end date of the call and calculates the number
' of hours duration of the incident.
'
' Weekends are excluded.
' Hours outside of the defined working day are ignored
'
Function elapsed(startDate As Date, endDate As Date) As String
Const cnWorkingHours As Integer = 9
Const cnStartOfDay As Integer = 8
Const cnEndOfDay As Integer = 17
Dim nStartDay As Integer
Dim nClearedDay As Integer
Dim nStartMonth As Integer
Dim nClearedMonth As Integer
Dim nEndHour As Integer
Dim nEndMinute As Integer
Dim nStartHour As Integer
Dim nStartMinute As Integer
Dim nElapsedDays As Integer
Dim nElapsedHours As Integer
Dim nElapsedMinutes As Integer
Dim nCount As Integer
Dim dWorkingDate As Date
'
' Used to work out if everything took place on one day. Month only needed, in case
' the problem took exactly 1 month to fix!!
'
nStartDay = Day(startDate)
nClearedDay = Day(endDate)
nStartMonth = Month(startDate)
nClearedMonth = Month(endDate)
'
' Set up the start and end times for the calculations. If the start time is before
' the start of the day, set it to the start of day (E.g. 04:30 become 08:00). Do
' the same for the end time, compared to end of working day.
'
If Hour(startDate) > cnStartOfDay Then
nStartHour = Hour(startDate)
nStartMinute = Minute(startDate)
Else
nStartHour = cnStartOfDay
nStartMinute = 0
End If
If Hour(endDate) < cnEndOfDay Then
nEndHour = Hour(endDate)
nEndMinute = Minute(endDate)
Else
nEndHour = cnEndOfDay
nEndMinute = 0
End If
'
' Check to see if everything occurs on 1 days:
'
If nStartDay = nClearedDay And nStartMonth = nClearedMonth Then
'
' Simple calculation, it took less than a day!
'
nElapsedDays = 0
nElapsedHours = nEndHour - nStartHour
'
' We need to adjust the minutes and hours, if the call wasn't logged on
' the hour.
'
If nStartMinute <= nEndMinute Then
'
' We only need to adjust the minutes
'
nElapsedMinutes = nEndMinute - nStartMinute
Else
nElapsedHours = nElapsedHours - 1
nElapsedMinutes = (60 + nEndMinute) - nStartMinute
End If
Else
'
' We need to go through each day and add in the hours, excluding
' weekends...
'
nElapsedDays = 0
nElapsedHours = 0
nElapsedMinutes = 0
dWorkingDate = startDate
'
' Loop through each day, adding 1 to the day count (with the exception of the
' first day, there we need to calculate whether it was a full day or whether
' we need to add the correct number of hours and minutes.
'
Do
'
' If it is the first day, do the calculations...
'
If dWorkingDate = startDate Then
If nStartHour = cnStartOfDay And nStartMinute = 0 Then
nElapsedDays = nElapsedDays + 1
Else
nElapsedHours = cnEndOfDay - nStartHour
If nStartMinute <> 0 Then
nElapsedHours = nElapsedHours - 1
nElapsedMinutes = 60 - nStartMinute
End If
End If
Else
'
' Otherwise, simply increment the day counter, if it isn't a weekend.
'
If Weekday(dWorkingDate) <> 1 And Weekday(dWorkingDate) <> 7 Then
nElapsedDays = nElapsedDays + 1
End If
End If
'
' Add 1 day to the working date
'
dWorkingDate = DateSerial(Year(dWorkingDate), Month(dWorkingDate), Day(dWorkingDate) + 1)
Loop While dWorkingDate <= endDate
'
' Now add in the hours and minutes for the last day - the loop above loops
' through all days, until the last day.
'
nElapsedHours = nElapsedHours + (nEndHour - cnStartOfDay)
nElapsedMinutes = nElapsedMinutes + nEndMinute
If nElapsedMinutes > 60 Then
nElapsedMinutes = nElapsedMinutes - 60
nElapsedHours = nElapsedHours + 1
End If
'
' NOTE : For working days, replace 24 with the cnWorkingHours!
'
If nElapsedHours > 24 Then
nElapsedHours = nElapsedHours - 24
nElapsedDays = nElapsedDays + 1
End If
End If
elapsed = CStr(nElapsedDays) & ":" & CStr(nElapsedHours) & ":" & CStr(nElapsedMinutes)
End Function
| 
