คำนวนหา จำนวน ปี เดือน วัน แยกออกจากกัน เพื่อนำมาหาวันทวีคูณ

Public Sub DateIntervals(ByVal Date1 As Date, ByVal Date2 As Date, ParamArray Prams())
        ' Returns the greatest full interval (years, months, days, hours, minutes, seconds) between two dates
        ' Ex1: DateIntervals Birthday, Now, Yr, Mo, Dy, Hr, Mn, Sec
        ' Ex2: DateIntervals Now, "25 Dec", , , Days
        ' <How many days until Christmas?
        If UBound(Prams) < 0 Then Exit Sub

        Dim Temp As Date
        Dim i As Long, itr As String * 1
        Const Interval = "mdhns"

        If (DateValue(Date1) = 0) Xor (DateValue(Date2) = 0) Then
        ' Assume today if one is a time and the other
        ' is a date...
                If DateValue(Date1) = 0 Then Date1 = Date1 + DateValue(Now)
                If DateValue(Date2) = 0 Then Date2 = Date2 + DateValue(Now)
        End If
        If Date1 > Date2 Then
                ' Swap dates if first is after second...
                ' Temp = Date1
                Date1 = Date2
                Date2 = Temp
        End If
        If Not IsMissing(Prams(0)) Then
                Prams(0) = Year(Date2) - Year(Date1)
                Temp = DateAdd("yyyy", Prams(0), Date1)
                Prams(0) = Prams(0) + (Temp > Date2)
                Date1 = DateAdd("yyyy", Prams(0), Date1)
                If UBound(Prams) < 1 Then Exit Sub
        End If
        For i = 1 To IIf(UBound(Prams) > 5, 5, UBound(Prams))
                If Not IsMissing(Prams(i)) Then
                        itr = Mid$(Interval, i, 1)
                        Prams(i) = DateDiff(itr, Date1, Date2)
                        Prams(i) = Prams(i) + (DateAdd(itr, Prams(i), Date1) > Date2)
                        Date1 = DateAdd(itr, Prams(i), Date1)
                End If
        Next i
End Sub