Public Sub Main()
    Dim dp As Date, d As Variant, h As Variant
    dp = (# 12 / 2 / 2009   12 : 28 : 00  AM# - # 12 / 1 / 2009   7 : 30 : 00  AM#) + (# 12 / 7 / 2009   12 : 10 : 00  AM# - # 12 / 4 / 2009   5 : 30 : 00  PM#)

    ' Если нам надо в днях и часах
    Debug.Print DateInterval(# 12 : 00 : 00  AM#, dp, , , d, h, , , True)
    Debug.Print d, h
End Sub

' Функция получает разницу между датами в заданных полных единицах даты/времени
' При ReturnString=True возвращает строковое представление интервала
Public Function DateInterval(d1 As Date, d2 As Date, _
        Optional Years As Variant, Optional Months As Variant, Optional Days As Variant, _
        Optional Hours As Variant, Optional Minutes As Variant, Optional Seconds As Variant, _
        Optional ReturnString As Boolean = False) As String
    
    Const sr As String = ", "
    Const y As String = "yyyy", m As String = "m", d As String = "d", _
        h As String = "h", n As String = "n", s As String = "s"
    Dim dm As Date, dd As Date, dh As Date, dn As Date, ds As Date, _
        ss As String, i As Integer, sss As String, s0 As String

    If IsMissing(Years) Then
        dm = d1
    Else
        Years = DateDiff(y, d1, d2)
        dm = DateAdd(y, Years, d1)
        If dm > d2 Then
            Years = Years -  1 
            dm = DateAdd(y, Years, d1)
        End If
        If ReturnString Then
            If Years Then
                ss = Right$(Format$(Years, "00"),  2 )
                If Right$(ss,  1 ) = "0" Or Left$(ss,  1 ) = "1" Or CInt(Right$(ss,  1 )) >=  5  Then
                    sss = Years & " лет"
                Else
                    sss = Years & " год"
                    If Right$(ss,  1 ) <> "1" Then sss = sss & "а"
                End If
            Else
                s0 = "лет"
            End If
        End If
    End If
    If IsMissing(Months) Then
        dd = dm
    Else
        Months = DateDiff(m, dm, d2)
        dd = DateAdd(m, Months, dm)
        If dd > d2 Then
            Months = Months -  1 
            dd = DateAdd(m, Months, dm)
        End If
        If ReturnString Then
            If Months Then
                ss = Right$(Format$(Months, "00"),  2 )
                If Len(sss) Then sss = sss & sr
                sss = sss & Months & " месяц"
                If Right$(ss,  1 ) = "0" Or Left$(ss,  1 ) = "1" Or CInt(Right$(ss,  1 )) >=  5  Then
                    sss = sss & "ев"
                Else
                    If Right$(ss,  1 ) <> "1" Then sss = sss & "а"
                End If
            Else
                s0 = "месяцев"
            End If
        End If
    End If
    If IsMissing(Days) Then
        dh = dd
    Else
        Days = DateDiff(d, dd, d2)
        dh = DateAdd(d, Days, dd)
        If dh > d2 Then
            Days = Days -  1 
            dh = DateAdd(d, Days, dd)
        End If
        If ReturnString Then
            If Days Then
                ss = Right$(Format$(Days, "00"),  2 )
                If Len(sss) Then sss = sss & sr
                sss = sss & Days & " д"
                If Right$(ss,  1 ) = "0" Or Left$(ss,  1 ) = "1" Or CInt(Right$(ss,  1 )) >=  5  Then
                    sss = sss & "ней"
                Else
                    sss = sss & IIf(Right$(ss,  1 ) = "1", "ень", "ня")
                End If
            Else
                s0 = "дней"
            End If
        End If
    End If
    If IsMissing(Hours) Then
        dn = dh
    Else
        Hours = DateDiff(h, dh, d2)
        dn = DateAdd(h, Hours, dh)
        If dn > d2 Then
            Hours = Hours -  1 
            dn = DateAdd(h, Hours, dh)
        End If
        If ReturnString Then
            If Hours Then
                ss = Right$(Format$(Hours, "00"),  2 )
                If Len(sss) Then sss = sss & sr
                sss = sss & Hours & " час"
                If Right$(ss,  1 ) = "0" Or Left$(ss,  1 ) = "1" Or CInt(Right$(ss,  1 )) >=  5  Then
                    sss = sss & "ов"
                Else
                    If Right$(ss,  1 ) <> "1" Then sss = sss & "а"
                End If
            Else
                s0 = "часов"
            End If
        End If
    End If
    If IsMissing(Minutes) Then
        ds = dn
    Else
        Minutes = DateDiff(n, dn, d2)
        ds = DateAdd(n, Minutes, dn)
        If ds > d2 Then
            Minutes = Minutes -  1 
            ds = DateAdd(n, Minutes, dn)
        End If
        If ReturnString Then
            If Minutes Then
                ss = Right$(Format$(Minutes, "00"),  2 )
                If Len(sss) Then sss = sss & sr
                sss = sss & Minutes & " минут"
                If Not (Right$(ss,  1 ) = "0" Or Left$(ss,  1 ) = "1" Or CInt(Right$(ss,  1 )) >=  5 ) Then
                    sss = sss & IIf(Right$(ss,  1 ) = "1", "а", "ы")
                End If
            Else
                s0 = "минут"
            End If
        End If
    End If
    If Not IsMissing(Seconds) Then
        Seconds = DateDiff(s, ds, d2)
        If ReturnString Then
            If Seconds Then
                ss = Right$(Format$(Seconds, "00"),  2 )
                If Len(sss) Then sss = sss & sr
                sss = sss & Seconds & " секунд"
                If Not (Right$(ss,  1 ) = "0" Or Left$(ss,  1 ) = "1" Or CInt(Right$(ss,  1 )) >=  5 ) Then
                    sss = sss & IIf(Right$(ss,  1 ) = "1", "а", "ы")
                End If
            Else
                s0 = "секунд"
            End If
        End If
    End If
    If ReturnString Then DateInterval = IIf(Len(sss), sss, "0 " & s0)
End Function