In VB there is no direct way of calculating (date & time ) - (date & time) = h:m:s without some great difficulty. Here is the simple way to do it including a load of comments for the beginner.
This function takes the following parameters:
Public Function GetTimeDiff(StartDate, EndDate, DateTimeFormat) As String
Where DateTimeFormat is 0 or 1.
'0 = "Date Time" with or without AM/PM 24 hour setting
'1 = "Time" with or without AM/PM 24 hour setting
Note that both StartD and EndD must be provided in the same DTF format. Please
note that returns are made in the form hh:mm:ss only, regardless of how large
a number of hours are, and has a theoretical upper limit 68 years.
Examples
'Call this function from a module or your form by the following ways and formating
options.
' GetTimeDiff(ByRef StartDate As Date, _ 'ByRef EndDate As Date, ByRef DTF As
Integer) As String
MsgBox GetTimeDiff("9/5/01 7:52:29 AM", "9/7/01 09:14:20 PM",
0)
MsgBox GetTimeDiff("9/5/01 7:52:29 AM", "9/7/01 9:14:20 PM",
0)
MsgBox GetTimeDiff("9/5/01 7:52:29", "9/7/01 21:14:20", 0)
MsgBox GetTimeDiff("7:52:29 AM", "9:14:20 PM", 1)
MsgBox GetTimeDiff("7:52:29 AM", "21:14:20", 1)
MsgBox can of course be altered to any object or variable.
Benchmark
1176.5 calculations per second, and 1,048,576 in 14 minutes and 51 seconds
while writing all values to a generated text file.
Without error handling this code could be reduced by 8 lines.
'©2001 - All rights reserved - MRJ Design
'Leave copyright notice intact for re-use!
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function GetTimeDiff(ByRef StartD As Date, _
EndD As Date, DTF As Integer) As String
On Error GoTo ErrEvt 'simple error handling
Dim ThePartH As Long 'derive hours total
Dim ThePartM As Long 'derive minutes total
Dim ThePartS As Long 'derive remaineder of seconds
Dim SecondsTot As Long 'for internal check only
Select Case DTF
Case 0
'No change neccessary
'The dates provided are already in Long format
Case 1
'convert the time to a long date format thus reducing
'the number of lines for correction of times
StartD = Date & " " & StartD
EndD = Date & " " & EndD
Case Else
'raise error
'Invalid integer option
GetTimeDiff = ""
Err.Raise 60980, , _
"You omitted a required Integer variable in the call of this function."
& vbCrLf & _ "The variable missing was the DTF format setting. Please
correct your Call and try again.", , ""
Exit Function
End Select
'This section is for error handling only
'It is added to prevent the user form entering
'values in incorrect order and similar user related errors
If StartD = EndD Then
'this is the result returned by the function
GetTimeDiff = "0:00:00"
Exit Function
ElseIf StartD > EndD Then
'this is the result returned by the function
GetTimeDiff = ""
Err.Raise 60981, , _
"The Calculation is invalid as a start date can not occure after it has
ended." & vbCrLf & _ "Check your input values and correct the
order of the dates/times entered.", , ""
Exit Function
End If
'This is the section doing the trick
'simply derive the sum of all seconds to
'hours, minutes and seconds
ThePartH = Int(DateDiff("s", StartD, EndD) / 3600) 'rounded off hours
ThePartM = Int((DateDiff("s", StartD, EndD) - (ThePartH * 3600)) /
60) 'rounded off minutes ThePartS = Int(DateDiff("s", StartD, EndD)
- (ThePartH * 3600) - (ThePartM * 60)) 'rest is seconds
'THIS IS JUST A SECOND CALCULATION FOR INTERNAL DEBUG 'SecondsTot = DateDiff("s",
StartD, EndD)
'THIS IS THE RETURN VALUE OF THE FUNCTION
GetTimeDiff = ThePartH & ":" & ThePartM & ":"
& ThePartS
Exit Function ' Avoid Error Handling
ErrEvt:
Select Case Err.Number
Case 60980
Err.Clear
MsgBox "Something went wrong here!" & vbCrLf
& _
Err.Description, vbCritical, "Input Error " &
Err.Number
Case 60981
Err.Clear
MsgBox "Something went wrong here!" & vbCrLf
& _
Err.Description, vbCritical, "Reversed Dates " &
Err.Number
Case Else
Err.Clear
MsgBox "Something went wrong here!" & vbCrLf
& _
Err.Description, vbCritical, "Error " & Err.Number
End Select
Resume Next
End Function
Comments