Who's up for a challenge!!
Enhanced version (checks wheter start/end date is a workday, simplified
holidays argument processing)
HTH
--
AP
'--------------
Option Explicit
Function WorkTime( _
dStart As Date, _
dEnd As Date, _
hInTime As Date, _
hOutTime As Date, _
Optional adHolidays As Variant)
Dim hStart As Date
Dim bStartIsWorkday As Boolean
Dim hEnd As Date
Dim bEndIsWorkday As Boolean
Dim dwStart As Date
Dim dwEnd As Date
Dim lWorkdays As Long
' Isolate hours from days
dwStart = Int(dStart)
dwEnd = Int(dEnd)
hStart = dStart - dwStart
hEnd = dEnd - dwEnd
' Check if dStart/dEnd is a Workday
bStartIsWorkday = (Networkdays(dwStart, dwStart, adHolidays) 0)
bEndIsWorkday = (Networkdays(dwEnd, dwEnd, adHolidays) 0)
'Resolve Start and End times to Working hours
If hStart < hInTime Then hStart = hInTime
If hEnd hOutTime Then hEnd = hOutTime
WorkTime = 0
If dwStart = dwEnd Then 'All on same day
'Calculate duration for first and only day
If bStartIsWorkday Then WorkTime = hEnd - hStart
Else 'Calculate duration for first day
If bStartIsWorkday And (hStart < hOutTime) Then WorkTime = hOutTime -
hStart
'Calculate duration for last day
If bEndIsWorkday And (hEnd hInTime) Then WorkTime = WorkTime + (hEnd -
hInTime)
End If
'Calculate duration for elapsed whole workdays
lWorkdays = Networkdays(dwStart, dwEnd, adHolidays)
If lWorkdays = 3 Then
WorkTime = WorkTime + (lWorkdays - 2) * (hOutTime - hInTime)
End If
End Function
'---------------------
|