Compute Age in many ways

ComputeAge.vbs

Option Explicit

' ***************************************************
' *
' * Description: 计算年龄
' * Author: wangye  <pcn88 at hotmail dot com>
' * Website: http://wangye.org
' *
' * Paramters:
' *    ByVal datetime    出生日期或者要比较的日期1
' *    ByVal curdatetime 要计算的间隔日期或者要比较的日期2
' *    ByVal grain       粒度，年龄计算或者日期比较粒度，分为：
' *            y   精确到年
' *            m   精确到月
' *            d   精确到日
' *            c   特殊标志，如果指定c，
' *                则表示将datetime转换标准日期变量
' *    ByVal comparetime  指示是计算datetime和curdatetime的间隔年龄
' *                       还是比较这两个时间（为True的时候）
' *                       当comparetime为True，那么
' *           datetime > curdatetime  返回 1
' *           datetime = curdatetime  返回 0
' *           datetime < curdatetime  返回 -1
' *
' * 可选项：
' *     curdatetime   默认为Now，计算机当前时间
' *     grain         默认为c，表示转换datetime
' *     comparetime   默认为False
' *
' * 返回值：
' *     当comparetime为False时返回由grain粒度控制的datetime和curdatetime
' *     时间间隔年龄，当comparetime为True时返回由grain粒度控制的
' *     datetime和curdatetime的大小-1 0 1（具体参考上面comparetime参数描述）
' *     当grain为c，表示仅转换datetime为脚本能够识别的合法日期变量。
' *     如果函数不能识别日期或者日期非法则返回vbObjectError+8(-2147221496)
' *
' * 备注：
' *     能够支持的日期格式有类似1972.01、1972.01.02、1972.1.2、72.01、72.01.02
' *     19720102、197201以及脚本能够控制的Date格式变量，可以通过
' *     IsDate函数判断为True的变量。
' *
' * 注意事项：
' *     日期不支持7201以及720102这样的格式，对于可能的错误格式
' *     会尝试按下面标准转换：
' *     761 => 1976.01    1976013 => 1976.01.03
' *     对于省略的月或者日，将按照1月或者1日看待，即1976将转换为1976-01-01
' *     1976.02将转换为1976.02.01
' *
' ***************************************************
Function ComputeAge( _
    ByVal datetime, _
    ByVal curdatetime, _
    ByVal grain, _
    ByVal comparetime)
    
    ComputeAge = vbObjectError+8
    
    Dim y,m,d,a
    datetime = Trim(datetime)
    If InStr(datetime, ".")>0 Then
        a = Split(datetime, ".")
        If UBound(a)=1 Then
            y = Trim(a(0))
            m = Trim(a(1))
        ElseIf UBound(a)=2 Then
            y = Trim(a(0))
            m = Trim(a(1))
            d = Trim(a(2))
        End If
    ElseIf IsDate(datetime) Then
        y = Year(datetime)
        m = Month(datetime)
        d = Day(datetime)
    ElseIf IsNumeric(datetime) Then
        y = CStr(CLng(datetime))
    Else
        Exit Function
    End If
    
    ' Fix long integer time format
    Select Case Len(y)
        Case 2
            y = "19" & y
        Case 3
            ' Possible incorrect format
            ' 761 => 1976.01
            m = Right(y, 1)
            y = "19" & Left(y, 1)
        Case 4
            ' Nothing to do
        Case 5
            ' Possible incorrect format
            ' 19761 => 1976.01
            m = Right(y, 1)
            y = Left(y, 4)
        Case 6
            ' 197601 => 1976.01
            m = Right(y, 2)
            y = Left(y, 4)
        Case 7
            ' Possible incorrect format
            ' 1976013 => 1976.01.03
            m = Mid(y, 5, 2)
            d = Right(y, 1)
            y = Left(y, 4)
        Case 8
            ' 19760103 => 1976.01.03
            m = Mid(y, 5, 2)
            d = Right(y, 2)
            y = Left(y, 4)
        Case Else
            Exit Function
    End Select
    
    If m="" Then m=1
    If d="" Then d=1
    
    y = CInt(y)
    m = CInt(m)
    d = CInt(d)
    
    If m<1 Or m>12 Then
        Exit Function
    End If
    
    If d<1 Or d>31 Then
        Exit Function
    End If
    
    datetime = y & "-" & Right("00" & m, 2) & _
            "-" & Right("00" & d, 2)
    If Not IsDate(datetime) Then Exit Function
    datetime = CDate(datetime)
    
    If  VarType(grain)<>vbString And _
        (Not IsNumeric(grain)) Then grain="c"
    If LCase(grain)="c" Then _
        ComputeAge = datetime : Exit Function
    
    If  VarType(curdatetime)=vbError Or _ 
        VarType(curdatetime)=vbEmpty Or _
        VarType(curdatetime)=vbNull Then
        curdatetime = Now()
    Else
        curdatetime = ComputeAge(curdatetime,,,False)
    End If
    If VarType(comparetime)<>vbBoolean Then _
            comparetime = False
 
    If Not IsDate(curdatetime) Then Exit Function
    curdatetime = CDate(curdatetime)
    
    If Not comparetime Then
        Select Case LCase(CStr(grain))
        Case "y","0"
            ComputeAge = DateDiff("yyyy", datetime, curdatetime)
        Case "m","1"
            ComputeAge = Int(DateDiff("m", datetime, curdatetime) / 12)
        Case "d","2"
            ComputeAge = Int(DateDiff("m", datetime, curdatetime) / 12)
            If m=Month(curdatetime) And d>Day(curdatetime) Then _
                    ComputeAge = ComputeAge-1
        End Select
    Else
        Select Case LCase(CStr(grain))
         Case "y","0"
            grain = "yyyy"
         Case "m","1"
            grain = "m"
         Case "d","2"
            grain = "d"
        End Select
        a = DateDiff(grain, curdatetime, datetime)
        If a>0 Then
            ComputeAge = 1
        ElseIf a<0 Then
            ComputeAge = -1
        Else
            ComputeAge = 0
        End If
    End If
End Function

WScript.Echo ComputeAge("19570321", Now, "y", False)
WScript.Echo ComputeAge("1957.3.21", Now, "y", False)

WScript.Echo ComputeAge("19570321", "2012", "y", False) ' 55
WScript.Echo ComputeAge("1957.3.21", "2012.01.03", "y", False) ' 55
WScript.Echo ComputeAge("1957.3.21", "2012.01.03", "m", False) ' 54
WScript.Echo ComputeAge("1957.3.21", "2012.03.22", "d", False) ' 55
WScript.Echo ComputeAge("1957.3.21", "2012.03.20", "d", False) ' 54

' Convert date to datetime variable
WScript.Echo ComputeAge("1957.3.21", , "c", False)

' Compare two date time by year, 1957 < 2001 return -1
WScript.Echo ComputeAge("1957.03.21", "2001.01.02", "y", True) ' -1
' Compare two date time by month, 1957.03 > 1957.02 return 1
WScript.Echo ComputeAge("1957.03.21", "1957.02", "m", True) ' 1
' Compare two date time by day, 1957.03.21 = 1957.03.21 return 0
WScript.Echo ComputeAge("1957.03.21", "1957.03.21", "d", True) ' 0

' Error occured "aaa" is not valid date time return vbObjectError+8
WScript.Echo ComputeAge("aaa", Now, "y", False) ' -2147221496