Date Function Parsing problem 2

[apkohn]

Hey all,

I have a program that needs to parse a two strings into a date type variable.

The first string contains the date in yyyymmdd format, whilst the second string is hh:nn format (well they should be, so I need error checking too).

Anyway here is the code:

Public Function MakeDate(strDate As String, strTime As String) As Date
    Dim strMonth As String
    
    If Not IsNumeric(strDate) Or Not (IsNumeric(Left(strTime, 2)) And IsNumeric(Right(strTime, 2))) Then
        MsgBox "Date and Time aren't numeric strings"
    Else
        If Len(strDate) <> 8 Or Len(strTime) <> 5 Then
            'Error
            MsgBox &quot;Lengths of Date or Time are wrong&quot;
        Else
            strMonth = GetMonth(Int(Mid(strDate, 5, 2)))
            
            MakeDate = DateValue(Right(strDate, 2) & &quot; &quot; & strMonth & &quot; &quot; & Left(strDate, 4))
            MakeDate = DateAdd(&quot;h&quot;, Left(strTime, 2), MakeDate)
            MakeDate = DateAdd(&quot;n&quot;, Right(strTime, 2), MakeDate)
        End If
    End If
End Function

Private Function GetMonth(intNumerical As Integer) As String
    Select Case intNumerical
        Case 1: GetMonth = &quot;Jan&quot;
        Case 2: GetMonth = &quot;Feb&quot;
        Case 3: GetMonth = &quot;Mar&quot;
        Case 4: GetMonth = &quot;Apr&quot;
        Case 5: GetMonth = &quot;May&quot;
        Case 6: GetMonth = &quot;Jun&quot;
        Case 7: GetMonth = &quot;Jul&quot;
        Case 8: GetMonth = &quot;Aug&quot;
        Case 9: GetMonth = &quot;Sep&quot;
        Case 10: GetMonth = &quot;Oct&quot;
        Case 11: GetMonth = &quot;Nov&quot;
        Case 12: GetMonth = &quot;Dec&quot;
    End Select
End Function

Anyway, this code works perfectly on multiple machines I have tried it on (Office 97 on NT, Office 97 on win98, Office 2000 on Windows 2000, Office 2000 on Win NT, and XP on XP), however, when I send the database to a colleague, he gets an error in this code. I can't get him to identify the line of the error, as I can only send him mde files, but can guarentee it occurs on calles to MakeDate.

The only difference I can identify is that his system date settings are different (though the above works on machines with both dd/mm/yy format and mm/dd/yy), or that because he is running a Hebrew version of Windows 2000/Office 2000 that is somehow causing the problem.

Can anyone shed some light?

 

[jmeadows7]

What is the error message that your friend receives? That will help narrow down the possibilities.

 

[MichaelRed]

I 'Guess' that " ... works perfectly ... " is -at best a relative statement, since it can obviously engender some difficulties. I do not really recommend the following, although it would appear to include most reasonable error checking on the input.

It is CERTAINLY NOT well tested, so at the least, I would suggest that YOU set up a test routine which EXTENSIVELY bangs into both the expected and Un-Expected, revising as necessary. An easy way to see any necessary "details" is to just put a breakpoint on the instruction following "ErrExit:".





MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[raskew]

Don't think the Hebrew version is the problem unless you're dealing with something other than the Gregorian calendar. Play with this from the debug window:

mydate = "20030620"
mytime = "14:30"
x = datevalue(mid(mydate, 5,2) & "/" & right(mydate, 2) & "/" & left(mydate, 4 ))
y = x + timevalue(myTime)
? y
6/20/03 2:30:00 PM
? cdbl
37792.6041666667
fmt = "mmm dd yyyy hh:nn"
? format(y, fmt)
Jun 20 2003 14:30

Keep in mind that the first thing that needs to happen is to get the string date-parts into a date/time data type. Once you've accomplished that, it's just a matter of formatting your display the way you want to see it (see the fmt = ... line above). The GetMonth() function is totally unnecessary and I'm surprised that Micheal Red got sucked into it.

 

[MichaelRed]

oh ... well ... not really 'sucked in' ... more like unto senile and forgetting to actually post the 'procedure'. I wasn't (because I'm an INSENSITIVE BRUTE!) going to explicitly mentiion the various 'oversights'.

    'The first string contains the date in yyyymmdd format, _
     whilst the second string is hh:nn format

    Dim MyYr As Integer
    Const LowYr = 1998
    Const HiYr = 2008

    Dim MyMnth As Integer
    Const LowMnth = 1
    Const HiMnth = 12

    Dim MyDay As Integer
    Const LowDay = 1
    Dim HiDay As Integer

    Dim MyHr As Integer
    Const LowHr = 0
    Const HiHr = 23

    Dim MyMin As Integer
    Const LowMin = 0
    Const HiMin = 59
    
    'Check overall Date String
    If (Len(strDate) <> 8) Then
        'Error
        MsgBox &quot;The Number of characters in The Date string is incorrect&quot;
        GoTo ErrExit
    End If

    'Check Length of tine string
    If (Len(strTime) <> 5) Then
        'Error
        MsgBox &quot;The Number of characters in The Time string is incorrect&quot;
        GoTo ErrExit
    End If

    If (Not IsNumeric(Left(strDate, 4))) Then
        MsgBox &quot;Year part of date is Not A numeric)&quot;
        GoTo ErrExit
    End If

    MyYr = CInt(Left(strDate, 4))

    If (MyYr < LowYr) Then
        MsgBox &quot;Year Value Below expected range&quot;
        GoTo ErrExit
    End If

    If (MyYr > HiYr) Then
        MsgBox &quot;Year Value Abovew expected range&quot;
        GoTo ErrExit
    End If

    If (Not IsNumeric(Mid(strDate, 5, 2))) Then
        MsgBox &quot;Month part of date is Not A numeric)&quot;
        GoTo ErrExit
    End If

    MyMnth = CInt(Mid(strDate, 5, 2))

    If (MyMnth < LowMnth) Then
        MsgBox &quot;Month Value Below acceptable range&quot;
        GoTo ErrExit
    End If

    If (MyMnth > HiMnth) Then
        MsgBox &quot;Month Value Abovew acceptable range&quot;
        GoTo ErrExit
    End If

    If (Not IsNumeric(Right(strDate, 2))) Then
        MsgBox &quot;Month part of date is Not A numeric)&quot;
        GoTo ErrExit
    End If

    MyDay = CInt(Right(strDate, 2))

    If (MyDay < LowDay) Then
        MsgBox &quot;Day Value Below acceptable range&quot;
        GoTo ErrExit
    End If

    If (MyDay <> 12) Then
        HiDay = Day(DateSerial(MyYr, MyMnth + 1, 0))
     Else
        HiDay = 31
    End If

    If (MyDay > HiDay) Then
        MsgBox &quot;Day Value Abovew acceptable range&quot;
        GoTo ErrExit
    End If

    If (Not IsNumeric(Left(strTime, 2))) Then
        MsgBox &quot;Hours part of Time is Not A numeric)&quot;
        GoTo ErrExit
    End If

    MyHr = CInt(Left(strTime, 2))

    If (MyHr < LowHr) Then
        MsgBox &quot;Hours Value Below acceptable range&quot;
        GoTo ErrExit
    End If

    If (MyHr > HiHr) Then
        MsgBox &quot;Hours Value Above acceptable range&quot;
        GoTo ErrExit
    End If

    If (Not IsNumeric(Right(strTime, 2))) Then
        MsgBox &quot;Minutes part of tims is Not A numeric)&quot;
        GoTo ErrExit
    End If

    If (Mid(strTime, 3, 1) <> &quot;:&quot;) Then
        MsgBox &quot;Time String is not properly delimited&quot;
        GoTo ErrExit
    End If

    MyMin = CInt(Right(strTime, 2))

    If (MyMin < LowMin) Then
        MsgBox &quot;Minutes Value Below acceptable range&quot;
        GoTo ErrExit
    End If

    If (MyMin > HiMin) Then
        MsgBox &quot;Minutes Value Above acceptable range&quot;
        GoTo ErrExit
    End If

    basStrs2Date = DateSerial(MyYr, MyMnth, MyDay) & Str(MyHr) & &quot;:&quot; & Str(MyMin)

NormExit:
    Exit Function

ErrExit:
    GoTo NormExit

End Function
[code]

As (previously) noted, it is quite a bit revised, and NOT what i would necessarily recommend in a production app.  The PRIMARY feature is just the somewhat extensive err checking for the date/time strings (which I have not extensvely tested myself), so [b]IF[/b] you use it at all, please 'read and head' the comments in the previous post re whay &quot;YOU&quot; should do.




MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[RickSpr]

Here's a complete module that implements a language- and country-independent solution.

' Set MinYear and MaxYear to whatever year range is reasonable for your app
Const MinYear = 1950
Const MaxYear = 2010

' Set ErrorBase to any number you want. It allows you to bump the error
' numbers raised by this module into a unique range.
Const ErrorBase = 8500

Public Function MakeDate(strDate As String, strTime As String) As Date
' This is compatible with your function, but it gives more detailed error
' messages, catches February 29th errors, and works correctly with any language
' or country.
    On Error GoTo ErrorHandler
    MakeDate = StringToDate(strDate, strTime)
    Exit Function
ErrorHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description
End Function

Public Function StringToDate(DateString As String, TimeString As String) As Date
' Returns a DateTime if strings represent a valid date & time, else raises an
' error. I extracted this because you might have places where you're converting
' imported data, and would rather trap an error than display a MsgBox the user
' wouldn't understand.
    Dim lngYear As Long, lngMonth As Long, lngDay As Long
    Dim lngHour As Long, lngMin As Long
    Dim result As Date
    
    ' Check for string length errors
    If Len(DateString) <> 8 Then RaiseError 1
    If Len(TimeString) <> 5 Then RaiseError 2
    ' Convert components into integers, checking for numeric and range as we go
    lngYear = Range(Left(DateString, 4), MinYear, MaxYear, 3, 5)
    lngMonth = Range(Mid(DateString, 5, 2), 1, 12, 3, 6)
    lngDay = Range(Right(DateString, 2), 1, 31, 3, 7)
    lngHour = Range(Left(TimeString, 2), 0, 23, 4, 8)
    lngMin = Range(Right(TimeString, 2), 0, 59, 4, 9)
    ' The time in a Date variable is expressed as a fraction of a day. It is
    ' calculated as (minutes into the day) / (1440 = minutes per day). If you
    ' had seconds, it would be calculated as (seconds into the day) / 86400.
    result = DateSerial(lngYear, lngMonth, lngDay) _
        + (lngHour * 60 + lngMin) / 1440
    ' If the day was invalid for the month, DateSerial adjusted it into the
    ' next month. Since that changes the day number, we can detect this error.
    If Day(result) <> lngDay Then RaiseError 10
    StringToDate = result
End Function

Private Function Range(ValueString As String, Minimum As Long, Maximum As Long, _
                       NumError As Long, RangeError As Long) As Long
' Converts a string to an integer and tests it against range limits. If the
' string is not numeric, raises error NumError; if it is out of range, raises
' error RangeError.
    Dim result As Long
    
    If Not IsNumeric(ValueString) Then RaiseError NumError
    result = CLng(ValueString)
    If result < Minimum Or result > Maximum Then RaiseError RangeError
    Range = result
End Function

Private Sub RaiseError(ErrNum As Long)
' Raises a StringToDate error
    'Err.Source = &quot;modStringToDate&quot;   ' uncomment if desired
    Select Case ErrNum
        Case 1
            Err.Description = &quot;Date must be 8 digits long in the format yyyymmdd&quot;
        Case 2
            Err.Description = &quot;Time must be in the format hh:mm&quot;
        Case 3
            Err.Description = &quot;Date is not numeric&quot;
        Case 4
            Err.Description = &quot;Time is not numeric (excluding ':' character)&quot;
        Case 5
            Err.Description = &quot;Year is out of range&quot;
        Case 6
            Err.Description = &quot;Month is not in the range 01-12&quot;
        Case 7
            Err.Description = &quot;Day is not in the range 01-31&quot;
        Case 8
            Err.Description = &quot;Hour is not in the range 00-23&quot;
        Case 9
            Err.Description = &quot;Minute is not in the range 00-59&quot;
        Case 10
            Err.Description = &quot;February 29th specified for a non-leap year&quot;
    End Select
    Err.Raise ErrNum + ErrorBase
End Sub

Rick Sprague
Want the best answers? See faq181-2886
To write a program from scratch, first create the universe. - Paraphrased from Albert Einstein