Code Listing 3: The Sliding Window Procedure for VBA
Public Function SafeCenturyVBA( _
varDateIn As Variant, _
intPivot As Integer) _
As Variant
' Comments : Returns the passed date with the century modified
' as determined by the specified pivot year. If the
' last two digits of the supplied date are less than
' or equal to the intPivot value, the 21st century is
' used. Otherwise, the 20th century is used.
' Note that any century information supplied in the
' varDateIn parameter is thrown away. This is because
' by the time a date gets to this procedure, VB has most
' likely already assumed the century and the date is
' therefore suspect.
' Parameters: varDateIn - variant containing a date. This can be
' a string or date, but must be one of the following
' formats:
' mm/dd/yy
' dd/mm/yy
' mm/dd/yyyy
' dd/mm/yyyy
' intPivot - year to pivot to the current century.
' Returns : variant of type 7 (date) containing the transformed
' date or Null if the passed value cannot be evaluated
' as a date or an error occurs.
'
Dim intYear As Integer
Dim fIsDate As Boolean
Dim fOk As Boolean
On Error GoTo PROC_ERR
' Assume failure
fOk = False
' Determine if the passed value can
Select Case VarType(varDateIn)
Case vbDate
' Its a date, simply work on the century
fOk = True
Case vbString
' Its a string so we use IsDate to determine if the value is
' valid as a date. Note that IsDate() uses the date settings
' in the Windows Control Panel to determine validity. Therefore
' certain date formats (such as "Monday, June 3rd, 1995") will
' not be considered a valid date by this procedure. See the
' procedure comments for valid date formats for use with this
' procedure.
On Error Resume Next
fIsDate = IsDate(varDateIn)
fOk = (Err = 0)
On Error GoTo PROC_ERR
Case vbLong
' Check to see if it is in the serial date range
fOk = (varDateIn > -657434 And varDateIn < 2958465)
Case Else
' Can't figure out what it is
End Select
If fOk Then
' Get the right-most two digits of the year. Note the use of
' Format function to ensure that the string we search in
' always has four digits.
intYear = CInt(Right$(Format(varDateIn, "yyyy"), 2))
' Pivot the century. Note the use of explicit, hard-coded
' centuries. While this may appear to be non-Year 2000
' compliant (don't hardcode century data), it does
' specify the full four digits of the year. And since
' we need to rely on this procedure to make exactly
' the assumption we want, the hard-coded values are correct.
If intYear > intPivot Then
' If the supplied two-digit year is greater than then
' pivot number, the returned value is in the 20th
' century.
intYear = 1900 + intYear
Else
' If the supplied two-digit year is less than or equal
' to the pivot number, the returned value is in the
' 21st century.
intYear = 2000 + intYear
End If
' Return the variant. Note that we we cast it explicitly as a date.
SafeCenturyVBA = CVDate(Month(varDateIn) & _
"/" & Day(varDateIn) & _
"/" & intYear)
Else
SafeCenturyVBA = Null
End If
PROC_EXIT:
Exit Function
PROC_ERR:
MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
"SafeCenturyVBA"
SafeCenturyVBA = Null
Resume PROC_EXIT
End Function
|