Instructions: Copy the declarations and code below and paste directly into your VB project
Declarations:
Const ERR_INVALID_DATE = 20000
Const ERR_INVALID_DATE_MSG = "Date Required"
Code:
'PURPOSE: Calculates a person's age
'PARAMETERS:
' BirthDate: the person's birthdate, in date or string format
'RelativeTo (Optional) the "as of" date. If not specified, the
'current date is used
'RETURNS: The person's age as of the date specified in
'RelativeTo, or as of the current date if RelativeTo isn't
'specified.
Public Function Age(BirthDate As Variant, _
Optional RelativeTo As Variant) As Integer
Dim dBDate As Date, dRelDate As Date
Dim bSubtractOne As Boolean
Dim iAns As Integer
If IsMissing(RelativeTo) Then
RelativeTo = Now
ElseIf Not IsDate(RelativeTo) Then
err.Raise ERR_INVALID_DATE, , ERR_INVALID_DATE_MSG
End If
If Not IsDate(BirthDate) Then err.Raise ERR_INVALID_DATE, , _
ERR_INVALID_DATE_MSG
dBDate = CDate(BirthDate)
dRelDate = CDate(RelativeTo)
iAns = Year(dRelDate) - Year(dBDate)
If Month(dBDate) <> Month(dRelDate) Then
bSubtractOne = Month(dBDate) > Month(dRelDate)
Else
bSubtractOne = Day(dBDate) > Day(dRelDate)
End If
If bSubtractOne Then iAns = iAns - 1
Age = iAns
End Function
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment