Binaryworld - TimeToString - Convert time to a descriptive string ... [ VB -> Date-Time ]

' convert a date value into a string in the format
'   YY years, MM months, DD days, HH hours, MM minutes, SS.HH seconds)
' you can also opt for time short format (HH h, MM m, SS s)

Function TimeToString(ByVal aDate As Date, Optional ShortTimeFormat As Boolean, _
  Optional showHundredths As Boolean) As String

  Dim y As Long, m As Long, d As Long
  Dim ho As Long, mi As Long, se As Long, hu As Long
  Dim res As String
  Dim days As Double

  days = CDbl(aDate)

  ' evaluate (approximate) year, month, and day
  y = Int(days / 365.25)
  m = (days - Int(y * 365.25)) \ 30
  d = (days - Int(y * 365.25) - m * 30)

  ' make some adjustments
  If d >= 30 Then
    m = m + 1
    d = d Mod 30
  End If
  If m >= 12 Then
    y = y + 1
    m = m Mod 12
  End If

  ' evaluate hours, minutes, and seconds
  ' 8640000 = number of Hundredths of seconds in a day
  hu = (days - Int(days)) * 8640000
  ho = (hu \ 360000)
  mi = (hu - ho * 360000) \ 6000
  se = (hu - ho * 360000 - mi * 6000) \ 100
  hu = hu Mod 1000

  ' build the result string
  If y Then
    res = CStr(y) & " year" & IIf(y <> 1, "s", "") & ", "
  End If

  If m Or Len(res) Then
    res = res & CStr(m) & " month" & IIf(m <> 1, "s", "") & ", "
  End If

  If d Or Len(res) Then
    res = res & CStr(d) & " day" & IIf(d <> 1, "s", "") & ", "
  End If

  If ho Or Len(res) Then
    res = res & CStr(ho) & IIf(ShortTimeFormat, " h", " hour" & IIf(ho <> 1, _
      "s", "")) & ", "
  End If

  If mi Or Len(res) Then
    res = res & CStr(mi) & IIf(ShortTimeFormat, " m", _
      " minute" & IIf(mi <> 1, "s", "")) & ", "
  End If

  ' always display seconds
  res = res & CStr(se) & IIf(ShortTimeFormat, " s", " second" & IIf(se <> 1, _
    "s", ""))

  TimeToString = res

End Function