TIP: Click on subject to list as thread! ANSI
echo: visual_basic
to: All
from: Rick Rothstein
date: 2004-12-30 15:58:00
subject: Re: limitation of datedif

> I use datediff() to determine the period between dates. This works
> perfectly, but...
> Datediff() calculates in days, hours or minutes. Instead of "500 days"
as
> result I want 1 year, .. months and .. days. Is there a solution in
VB6 or
> do I need to calculate it myself. If so, anyone a good idea?

Months are a tricky thing when used as part of a Year/Month/Day time
period... it has to be calculated individually. Here is a past posting
of mine that provided a function (actually, two functions) that you can
probably make use of. Note that they both include the time as well as
date in their output, so you might want to modify them for your own use.

Rick - MVP

 I had a function which
calculates time elapsed given two dates; so I modified it for you. This
first version gives you time elapsed with "WEEKS" as one of the
sub-intervals; the second one without the "WEEKS" sub-interval. (Note
the function name differences.) Hopefully one of these is what you were
looking for.

Version #1 (With "WEEKS")
==========================
Function YMWDHMS(ByVal SecondsIn As Variant) As String
  Dim TempDate As Date
  Dim NumOfYears As Long
  Dim NumOfMonths As Long
  Dim NumOfWeeks As Long
  Dim NumOfDays As Long
  Dim NumOfHMS As Double
  Dim TSerial1 As Double
  Dim TSerial2 As Double
    Date2 = Now
    Date1 = DateAdd("s", -SecondsIn, Date2)
    NumOfYears = DateDiff("yyyy", Date1, Date2)
    TSerial1 = TimeSerial(Hour(Date1), Minute(Date1), Second(Date1))
    TSerial2 = TimeSerial(Hour(Date2), Minute(Date2), Second(Date2))
    NumOfHMS = 24 * (TSerial2 - TSerial1)
    If NumOfHMS < 0 Then
      NumOfHMS = NumOfHMS + 24
      Date2 = DateAdd("d", -1, Date2)
    End If
    Date1 = DateSerial(Year(Date2), Month(Date1), Day(Date1))
    If Date1 > Date2 Then
       Date1 = DateAdd("yyyy", -1, Date1)
       NumOfYears = NumOfYears - 1
    End If
    NumOfMonths = DateDiff("m", Date1, Date2)
    Date1 = DateSerial(Year(Date2), Month(Date2), Day(Date1))
    If Date1 > Date2 Then
       Date1 = DateAdd("m", -1, Date1)
       NumOfMonths = NumOfMonths - 1
    End If
    NumOfDays = Abs(DateDiff("d", Date1, Date2))
    NumOfWeeks = NumOfDays \ 7
    NumOfDays = NumOfDays Mod 7
    ' Format the Years, Months, Weeks, Days part
    YMWDHMS = CStr(NumOfYears) & " year" & _
              IIf(NumOfYears = 1, "", "s")
    YMWDHMS = YMWDHMS & ", "
    YMWDHMS = YMWDHMS & CStr(NumOfMonths) & _
                             " month" & IIf(NumOfMonths = 1,
"", "s")
    YMWDHMS = YMWDHMS & ", "
    YMWDHMS = YMWDHMS & CStr(NumOfWeeks) & _
                             " week" & IIf(NumOfWeeks = 1,
"", "s")
    YMWDHMS = YMWDHMS & ", "
    YMWDHMS = YMWDHMS & CStr(NumOfDays) & _
                             " day" & IIf(NumOfDays = 1,
"", "s")
    ' Format the Hours, Minutes and Seconds part
    YMWDHMS = YMWDHMS & ", "
    YMWDHMS = YMWDHMS & CStr(Int(NumOfHMS)) & _
                             " hour" & IIf(Int(NumOfHMS) = 1,
"", "s")
    NumOfHMS = 60 * (NumOfHMS - Int(NumOfHMS))
    YMWDHMS = YMWDHMS & ", "
    YMWDHMS = YMWDHMS & CStr(Int(NumOfHMS)) & _
                             " minute" & IIf(Int(NumOfHMS) =
1, "", "s")
    NumOfHMS = 60 * (NumOfHMS - Int(NumOfHMS))
    YMWDHMS = YMWDHMS & ", "
    YMWDHMS = YMWDHMS & CStr(CInt(NumOfHMS)) & _
                             " second" & IIf(Int(NumOfHMS) =
1, "", "s")
End Function


Version #2 (Without "WEEKS")
=============================
Function YMDHMS(ByVal SecondsIn As Variant) As String
  Dim TempDate As Date
  Dim NumOfYears As Long
  Dim NumOfMonths As Long
  Dim NumOfWeeks As Long
  Dim NumOfDays As Long
  Dim NumOfHMS As Double
  Dim TSerial1 As Double
  Dim TSerial2 As Double
    Date2 = Now
    Date1 = DateAdd("s", -SecondsIn, Date2)
    NumOfYears = DateDiff("yyyy", Date1, Date2)
    TSerial1 = TimeSerial(Hour(Date1), Minute(Date1), Second(Date1))
    TSerial2 = TimeSerial(Hour(Date2), Minute(Date2), Second(Date2))
    NumOfHMS = 24 * (TSerial2 - TSerial1)
    If NumOfHMS < 0 Then
      NumOfHMS = NumOfHMS + 24
      Date2 = DateAdd("d", -1, Date2)
    End If
    Date1 = DateSerial(Year(Date2), Month(Date1), Day(Date1))
    If Date1 > Date2 Then
       Date1 = DateAdd("yyyy", -1, Date1)
       NumOfYears = NumOfYears - 1
    End If
    NumOfMonths = DateDiff("m", Date1, Date2)
    Date1 = DateSerial(Year(Date2), Month(Date2), Day(Date1))
    If Date1 > Date2 Then
       Date1 = DateAdd("m", -1, Date1)
       NumOfMonths = NumOfMonths - 1
    End If
    NumOfDays = Abs(DateDiff("d", Date1, Date2))
    ' Format the Years, Months, Weeks, Days part
    YMDHMS = CStr(NumOfYears) & " year" & _
              IIf(NumOfYears = 1, "", "s")
    YMDHMS = YMDHMS & ", "
    YMDHMS = YMDHMS & CStr(NumOfMonths) & _
                             " month" & IIf(NumOfMonths = 1,
"", "s")
    YMDHMS = YMDHMS & ", "
    YMDHMS = YMDHMS & CStr(NumOfDays) & _
                             " day" & IIf(NumOfDays = 1,
"", "s")
    ' Format the Hours, Minutes and Seconds part
    YMDHMS = YMDHMS & ", "
    YMDHMS = YMDHMS & CStr(Int(NumOfHMS)) & _
                             " hour" & IIf(Int(NumOfHMS) = 1,
"", "s")
    NumOfHMS = 60 * (NumOfHMS - Int(NumOfHMS))
    YMDHMS = YMDHMS & ", "
    YMDHMS = YMDHMS & CStr(Int(NumOfHMS)) & _
                             " minute" & IIf(Int(NumOfHMS) =
1, "", "s")
    NumOfHMS = 60 * (NumOfHMS - Int(NumOfHMS))
    YMDHMS = YMDHMS & ", "
    YMDHMS = YMDHMS & CStr(CInt(NumOfHMS)) & _
                             " second" & IIf(Int(NumOfHMS) =
1, "", "s")
End Function
---
þ RIMEGate(tm)/RGXPost V1.14 at BBSWORLD * Info{at}bbsworld.com

---
 * RIMEGate(tm)V10.2áÿ* RelayNet(tm) NNTP Gateway * MoonDog BBS
 * RgateImp.MoonDog.BBS at 12/30/04 3:58:37 PM
* Origin: MoonDog BBS, Brooklyn,NY, 718 692-2498, 1:278/230 (1:278/230)
SEEN-BY: 633/267 270 5030/786
@PATH: 278/230 10/345 106/1 2000 633/267

SOURCE: echomail via fidonet.ozzmosis.com

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.