由出生日期返回年龄

Public Function BirthdayToAge(ByVal BirthDate As String) As String
'函数功能:由出生日期返回年龄
'入口参数:出生日期
'函数返回:出错或非正常返回为 vbnullstring,否则为年龄的字符串
'         <1个月 为 几天
'         <1年为 几月零几天
'         <6年为 几年零几月
    Dim myYear As Integer
    Dim myMonth As Integer
    Dim myDay As Integer
    Dim CurDate As String
    CurDate = ServerDate
    If Not IsDate(BirthDate) Then
        BirthdayToAge = vbNullString
        Exit Function
    End If
   
    If myYear > Year(CurDate) Then
        BirthdayToAge = vbNullString
        Exit Function
    End If
    '千年问题
    If CDate(BirthDate) < Format("2029-12-30", "YYYY-MM-DD") And CDate(BirthDate) > Format("2008-12-30", "YYYY-MM-DD") Then
        myYear = 100 - Val(Format(BirthDate, "YY")) + Val(Format(CurDate, "YY"))
        GoTo MYear
    End If
    '计算年
    If Month(CurDate) >= Month(CDate(BirthDate)) Then
        myYear = -DateDiff("YYYY", CurDate, CDate(BirthDate))
    Else
        myYear = -DateDiff("YYYY", CurDate, CDate(BirthDate)) - 1
    End If
MYear:
    '计算月
    myMonth = -DateDiff("m", CurDate, CDate(BirthDate)) Mod 12
    'myDay = -DateDiff("d", Date, CDate(Str(Year(Date)) & "-" & Str(Month(Date)) & "-" & Str(Day(CDate(BirthDate)))))
    myDay = Day(CDate(BirthDate)) - Day(CurDate)
    If myYear >= 6 Then
        If myMonth >= 6 Then
            BirthdayToAge = Str(myYear + 1) & "岁"
        Else
            BirthdayToAge = Str(myYear) & "岁"
        End If
        Exit Function
    End If
    If myYear > 0 Then
        If myMonth <> 0 Then
            BirthdayToAge = Str(myYear) & "岁零" & Str(myMonth) & "个月"
        Else
            BirthdayToAge = Str(myYear) & "岁整"
        End If
        Exit Function
    End If
    If myMonth > 0 Then
        If myDay <> 0 Then
            BirthdayToAge = Str(myMonth) & "个月零" & Str(myDay) & "天"
        Else
            BirthdayToAge = Str(myMonth) & "个月整"
        End If
        Exit Function
    End If
    BirthdayToAge = Str(myDay) & "天"
   
End Function