Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Date routine /Y2k

Status
Not open for further replies.
Oct 22, 2001
215
US
Does any one got the Y2k date check logic handy done in VB?
I am using 'is date' function but it is not catching dates that are bad but could be valid like (Year =999, 99, 200)
and I need to fix them as (1999, 1999, 2000) and so forth.
Thans again@
 
bengalliboy,
Is this a date field or a string? Date fields automatically update years entered to 4-digit years, even if they only display 2.

If it is a string field, are they all entered as m/d/y (where "y" is a 2-4 digit year)? If so, you might want to create a module with the following function (and this is off the top of my head and not tested, so my apologies if there are errors):

Function Str2Date(strDate As String) As Date
On Error GoTo Err_Str2Date

Dim intMonth As Integer
Dim intDay As Integer
Dim intYear As Integer
Dim strManipulate As String

'This function returns a date if it can
'possibly be converted. Else, it returns
'Null
'Function assumes m/d/y format or m/y format
'Non-traditional dates are converted as follows:
'Years from 0-20 are converted to 2000-2020
'Years from 21-99 are converted to 1921-1999
'Years from 100-999 are converted to 1100-1999

Str2Date = Null

If IsDate(strDate) Then
Str2Date = CDate(strDate)
Else
strManipulate = strDate
If InStr(strManipulate, "/") > 0 Then
'Find month
intMonth = Left(strManipulate, _
InStr(strManipulate, "/") - 1)
strManipulate = Mid(strManipulate, _
InStr(strManipulate, "/") + 1)

'Find day
If InStr(strManipulate, "/") > 0 Then
intDay = Left(strManipulate, _
InStr(strManipulate, "/") - 1)
strManipulate = Mid(strManipulate, _
InStr(strManipulate, "/") + 1)
Else
'Assume day not entered, go right
'to year

intDay = 1
End If

'If remainder is a number between 00
'and 9999, return true
'Note: this only works in countries
'where the decimal separator is "."

If IsNumeric(strManipulate) And _
InStr(strManipulate, ".") = 0 Then

If CInt(strManipulate) >= 0 And _
CInt(strManipulate) <= 9999 Then
intYear = CInt(strManipulate)

If intYear < 1000 And _
intYear >= 100 Then
'Convert 3-digit by adding 1000
intYear = intYear + 1000

ElseIf intYear < 100 And _
intYear > 20 Then
'Convert 2-digit by adding 1900
intYear = intYear + 1900

ElseIf intYear <= 20 Then
'Convert 2-digit by adding 2000
intYear = intYear + 2000

End If

Str2Date = DateSerial(intYear, _
intMonth, intDay)
End If
End If
End If
End If

Exit_Str2Date:
Exit Function

Err_Str2Date:
MsgBox Err.Description, , &quot;Str2Date: &quot; & Err.Number
Str2Date = Null
Resume Exit_Str2Date
End Function


Hope that helps! :)
 
I am a bit confused by the choice of &quot;20&quot; as the break point between the centuries. Ms. uses #1/1/30#. I also thought the process was a bit more &quot;logical&quot; than computational. Thus my offering. MyApologies to Katerine for borrowing her function name and the error label, at first I thought the changes would somwhat less extensive and this would be submitted as a revision of her work. The process turns out to be more of a re-design than just a revision of the code.


Please note that there are a few OPTIONAL arguments here which need to be understood, as they provide the real flexability of hte routine.

Code:
Function Str2Date(strDate As String, Optional DtSep As String = &quot;/&quot;, _
                  Optional DtOrder As String = &quot;mdy&quot;) As Date

    'Michael Red 1/25/2002

    On Error GoTo Err_Str2Date

    Dim strMan As Variant
    Dim MyMnth As Integer
    Dim MyDay As Integer
    Dim MyYr As Integer
    
    'This function returns a date if it can.

    'The Optional DtSep arg allows the seperator symbol to be
    'Set by the call, but defaults to the standard &quot;/&quot;.

    'The Optional DtOrder Argument allows the &quot;m/d/y&quot; order to
    'be specified.  If provided, it MUSY be a three char string
    'of &quot;m&quot; and &quot;d&quot; and &quot;y&quot; in any order, however the seperate
    'parts are then coerced to the respective datepart.  The default
    '(&quot;mdy&quot;) formats the date in the &quot;US&quot; format.

    'The Date order is assumed to be m/d/y.
    'If this doesn't work:
    '    &quot;m&quot; is > 12 or &quot;d&quot; < # days in month, we attempt to use d/m/y.
    'If the d/m/y format doesn't work:
    '   &quot;d&quot; > # days in &quot;m&quot; or &quot;m&quot; > 12,
    'we will attempt the y/m/d arrangement.
    'If all of these fail, return the Error (Null)

    strMan = Split(strDate, DtSep)

    'Check that there are Three (and ONLY Three parts)
    If (UBound(strMan) <> 2) Then
        GoTo Err_Str2Date
    End If

    'Check that each part is an Integer
    Do While Idx <= UBound(strMan)

        'First, check that is is a number
        If (IsNumeric(strMan(Idx))) Then
            strMan(Idx) = Val(strMan(Idx))
         Else
            GoTo Err_Str2Date
        End If

        'Now Check it is An Integer
        If (Int(strMan(Idx)) <> Val(strMan(Idx))) Then
            GoTo Err_Str2Date
        End If

        Idx = Idx + 1
    Loop

    Idx = 1
    Do While Idx <= Len(DtOrder)
        Select Case Mid(UCase(DtOrder), Idx, 1)
            Case Is = &quot;M&quot;
                MyMnth = strMan(Idx - 1)
            Case Is = &quot;D&quot;
                MyDay = strMan(Idx - 1)
            Case Is = &quot;Y&quot;
                MyYr = strMan(Idx - 1)
        End Select
        Idx = Idx + 1
    Loop

    Str2Date = DateSerial(MyYr, MyMnth, MyDay)

Exit_Str2Date:
    Exit Function
    
Err_Str2Date:
    MsgBox Err.Description, , &quot;Str2Date: &quot; & Err.Number
    Resume Exit_Str2Date

End Function

Since both my breakpoint and logic are quite different, I did a larger number than usual &quot;examples&quot; and thus did NOT want to include them in an already extensive bit of commentary, so these are provided below.

? Format(str2Date(&quot;12/31/29&quot;), &quot;mm/dd/yyyy&quot;)
MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over
 
Hi Mike,
Thanks! I'd never encountered the Split function before.. gave me something new to learn :)

Also thanks for the revision, it's helping to teach a new way of going about things (my code does tend to be &quot;logical,&quot; just because that's the way I tend to think).

Oh, FYI, there was no great logic behind my picking &quot;20&quot; as the break point.. my mind was as fuzzy as my eyesight this morning, and I more or less picked 20 at random, because it just seemed to make sense at the time :) I know, bad.. bad.. Katie
Hi! I'm currently studying the COM+ programming model. Hopefully YOU'RE having fun, which would make one of us..
 
Thanks both of you. You guies are amazing. I really learn new stuff every day from this forum. Thanx again!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top