View Single Post
Old 06-29-2009   #4 (permalink)
ekkehard.horner


 
 

Re: Date duration function that returns years, months, weeks anddays?

HAL07 schrieb:
Quote:

> Hi there, do anybody by chance have such a function laying around?
>
> I would like to e.g. output wscript.echo "You are " &
> dateduration(now(), "1980.01.04", "13:42" ) & " old."
>
> Will output:
> You are 29 years, x months, x weeks, x hours and x seconds old
>
To get you started:

Dim dtNow : dtNow = #6/29/2009 01:02:03#
Dim aBirth : aBirth = Array( #1/4/1980 13:42:00#, #7/13/1953 07:08:09#, dtNow, dtNow
- 7, #2/29/2004 01:02:03# )

Dim dtBirth
For Each dtBirth In aBirth
DateDiffUnits dtNow, dtBirth
WScript.Echo
Next

Function DateDiffUnits( dtNow, dtBirth )
ReDim aRVal( 6 )
Dim aUnits : aUnits = Array( "yyyy", "m", "ww", "d", "h", "n", "s" )
Dim dtCalc : dtCalc = dtBirth
Dim nIdx, dtTmp

WScript.Echo dtCalc
For nIdx = 0 To UBound( aUnits )
aRVal( nIdx ) = DateDiff( aUnits( nIdx ), dtCalc, dtNow )
dtTmp = DateAdd( aUnits( nIdx ), aRVal( nIdx ), dtCalc )
If dtTmp > dtNow Then aRVal( nIdx ) = aRVal( nIdx ) - 1
dtCalc = DateAdd( aUnits( nIdx ), aRVal( nIdx ), dtCalc )
WScript.Echo dtCalc, Right( " " & aRVal( nIdx ), 2 ), aUnits( nIdx )
Next
WScript.Echo dtNow

If dtNow <> dtCalc Then
WScript.Echo "Surprise", dtNow, dtCalc
End If

DateDiffUnits = aRVal
End Function

output:

=== OldAge: you are y m w h m s old =======
04.01.1980 13:42:00
04.01.2009 13:42:00 29 yyyy
04.06.2009 13:42:00 5 m
25.06.2009 13:42:00 3 ww
28.06.2009 13:42:00 3 d
29.06.2009 00:42:00 11 h
29.06.2009 01:02:00 20 n
29.06.2009 01:02:03 3 s
29.06.2009 01:02:03

13.07.1953 07:08:09
13.07.2008 07:08:09 55 yyyy
13.06.2009 07:08:09 11 m
27.06.2009 07:08:09 2 ww
28.06.2009 07:08:09 1 d
29.06.2009 00:08:09 17 h
29.06.2009 01:01:09 53 n
29.06.2009 01:02:03 54 s
29.06.2009 01:02:03

29.06.2009 01:02:03
29.06.2009 01:02:03 0 yyyy
29.06.2009 01:02:03 0 m
29.06.2009 01:02:03 0 ww
29.06.2009 01:02:03 0 d
29.06.2009 01:02:03 0 h
29.06.2009 01:02:03 0 n
29.06.2009 01:02:03 0 s
29.06.2009 01:02:03

22.06.2009 01:02:03
22.06.2009 01:02:03 0 yyyy
22.06.2009 01:02:03 0 m
29.06.2009 01:02:03 1 ww
29.06.2009 01:02:03 0 d
29.06.2009 01:02:03 0 h
29.06.2009 01:02:03 0 n
29.06.2009 01:02:03 0 s
29.06.2009 01:02:03

29.02.2004 01:02:03
28.02.2009 01:02:03 5 yyyy
28.06.2009 01:02:03 4 m
28.06.2009 01:02:03 0 ww
29.06.2009 01:02:03 1 d
29.06.2009 01:02:03 0 h
29.06.2009 01:02:03 0 n
29.06.2009 01:02:03 0 s
29.06.2009 01:02:03

=== OldAge: 0 done (00:00:00) ==============
My System SpecsSystem Spec