A better CDate for VB6

Question

We have a a VB6 app (in a COM component) which uses CDate() to take a string and cast it to a Date, for storing in a database. Depending on if we want the application to talk in dd/MM/yy or MM/dd/yy for example, we have to change the regional settings of the identity user for the COM application. (Right now the only option we have is a nasty hack.) We have a date format string which is used for formatting all output dates, and it is assumed that the date If this were .NET we would use DateTime.ParseExact and be away laughing. Calling out to a COM object written in .NET for this sole purpose is an option. Is there a different or better option, involving some black magic around the Format command, or a long reusable function that tokenizes the date depending on the format string, etc?

Accepted Answer

This should be close, though it hardcodes the delimiter as "/" and windows YY years at 50:

```
Private Function ParseDate(ByVal DateString As String, _
                           ByVal DatePattern As String) As Date
    'DateString:  i/j/k formatting.
    'DatePattern: i/j/k formatting, each to be:
    '               M or MM for month position.
    '               D or DD for day position.
    '               YY or YYYY for year position, if YY
    '                 then century windowed at 50.
    Dim strStringParts() As String
    Dim strPatternParts() As String
    Dim intPart As Integer, intScore As Integer
    Dim intMonth As Integer, intDay As Integer, intYear As Integer
    Const DELIM As String = "/"
    Const YYWINDOW As Integer = 50

strStringParts = Split(DateString, DELIM)
    strPatternParts = Split(UCase$(DatePattern), DELIM)
    For intPart = 0 To UBound(strStringParts)
        If intPart > UBound(strPatternParts) Then
            Err.Raise 5, "ParseDate"
        End If
        Select Case strPatternParts(intPart)
            Case "M", "MM"
                intMonth = CInt(strStringParts(intPart))
                intScore = intScore Or &H1
            Case "D", "DD"
                intDay = CInt(strStringParts(intPart))
                intScore = intScore Or &H2
            Case "YY"
                intYear = CInt(strStringParts(intPart))
                If 0 > intYear Or intYear > 99 Then
                    Err.Raise 5, "ParseDate"
                End If
                intYear = intYear + IIf(intYear < YYWINDOW, 2000, 1900)
                intScore = intScore Or &H4
            Case "YYYY"
                intYear = CInt(strStringParts(intPart))
                If 100 > intYear Or intYear > 9999 Then
                    Err.Raise 5, "ParseDate"
                End If
                intScore = intScore Or &H4
            Case Else
                Err.Raise 5, "ParseDate"
        End Select
    Next
    If intScore = &H7 Then
        ParseDate = DateSerial(intYear, intMonth, intDay)
    Else
        Err.Raise 5, "ParseDate"
    End If
End Function
```

Validation may not be perfect, but it ought to be close. It throws "Invalid procedure call or argument (Error 5)" on bad inputs.

A better CDate for VB6

Solution

Problem

Related problems