Send 2 date values to this function and it will return the difference in words, in GOOD english with comma's and "and"'s where necesary.
EXAMPLE:
lets say A = 09:30:23 and B = 11:17:22, calling this function, sending A as the 1st parameter and B as the 2nd parameter will return "1 hour, 46 minutes and 59 seconds"
I just use it to determine and display how long someone has been logged in to one of my programs. handy though!
here it is...for anyone that could use it...
Code:Public Function TimeDiffString(dtmStart, dtmEnd) As String On Error GoTo ErrorHandler Dim intHrs, intMins, intSecs As Integer Dim strHrsString, strMinsString, strSecsString As String 'Calculate the mins and secs intHrs = DateDiff("h", dtmStart, dtmEnd) intMins = DateDiff("n", dtmStart, dtmEnd) Mod 60 intSecs = DateDiff("s", dtmStart, dtmEnd) Mod 60 'May need to take 1 off the minutes and the hours If CInt(Format(dtmEnd, "nn")) < CInt(Format(dtmStart, "nn")) Then intHrs = intHrs - 1 If CInt(Format(dtmEnd, "ss")) < CInt(Format(dtmStart, "ss")) Then intMins = intMins - 1 'Create the strings If intHrs <= 0 Then strHrsString = "" ElseIf intHrs = 1 Then strHrsString = " 1 hour" Else strHrsString = " " & intHrs & " hours" End If If intMins <= 0 Then strMinsString = "" ElseIf intMins = 1 Then strMinsString = " 1 minute" Else strMinsString = " " & intMins & " minutes" End If If intSecs <= 0 Then strSecsString = "" ElseIf intSecs = 1 Then strSecsString = " 1 second" Else strSecsString = " " & intSecs & " seconds" End If 'If all aren't "" then will need an 'and' If strMinsString <> "" And strSecsString <> "" Then strMinsString = strMinsString & " and" If strHrsString <> "" Then strHrsString = strHrsString & "," ElseIf strHrsString <> "" And (strMinsString <> "" Or strSecsString <> "") Then strHrsString = strHrsString & " and" End If 'Result TimeDiffString = strHrsString & strMinsString & strSecsString CleanUp: Exit Function ErrorHandler: MsgBox Err.Description, , Err.Number Resume CleanUp End Function




Reply With Quote