Best CDate for VB6

Question

We have a VB6 application (in the COM component) that uses CDate () to take a string and pass it to Date for storage in the database.

Depending on whether we want the application to speak in the format dd / MM / yy or MM / dd / yy, for example, we must change the regional settings of the authentication user for the COM application. (Right now, the only option we have is a nasty hack .)

We have a date format string that is used to format all output dates, and it is assumed that the date

If it were .NET, we would use DateTime.ParseExact and not laugh. A call to a COM object written in .NET for this sole purpose is an option. Is there any other or better option related to black magic around the Format command or a long reusable function that tokens the date depending on the format string, etc.?

Answer 1

This should be close, although 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 ideal, but it should be close. It throws "Invalid call or procedure argument (Error 5)" on bad inputs.

Answer 2

, - . freeform , , -. .., . . , , .NET , .

Fwiw, Mike VB6. , VB.NET? , / Date, , , Format(). .

A) , B) , , , . , , , , , ? ( , , , ClassicVB - .)

Answer 3

DateAdd .

ThisLine =  "Tuesday, September 04, 2012 2:02 PM"

i = InStr(ThisLine, ",")  ' get rid of the leading day

If i > 0 Then
     TempResult = Trim(Right$(ThisLine, Len(ThisLine) - i))
end if

TempResult = DateAdd("s", 0, TempResult)

Answer 4

. , DateSerial, , VB6 Date. - . , (. ). , DateTime.ParseExact.

sInput = "1/3/71"
Dim splt() As String
splt = Split(sInput, "/")
dte = DateSerial(splt(2) + 1900, splt(1), splt(0))  ' dd/mm/yy'

Answer 5

Format, .

, :

Public Sub TestDateParsing()

   'On my computer, the date format is U.S. (mm/dd/yyyy)'
   'This test creates a date string in dd/mm/yyyy format to'
   'simulate user input in a different format'

    Const TEST_DATE As Date = #6/1/2009#

    Dim inputDate As String
    inputDate = Format(TEST_DATE, "dd/mm/yyyy")
    'inputDate is "1/6/2009" (June 1 in dd/mm/yyyy format)'

    Debug.Print Format(inputDate, "dd/mm/yyyy")
    'It`s magic! The above line will print 6/1/2009'
    'which is the correct format for my Regional Settings'

End Sub

, . Format .

, , "mm/dd/yyyy" .

"dd/mm/yyyy". Format Format "dd/mm/yyy", , , "mm/dd/yyyy".

, Format , ( "mm/dd/yyyy"), , , "dd/mm/yyyy", . , , : Format . ?;)

, "dd/mm/yyyy", "mm/dd/yyyy".

, , . ( ).

---

EDIT ( MarkJ) - , Date. , , , .

Public Sub Test()
  Dim dte As Date
  For dte = #1/1/2009# To #12/31/2009#
    Call TestDateParsing(dte)
  Next dte
End Sub

Public Sub TestDateParsing(ByVal dteIn As Date)

  'On my computer, the date format is U.S. (mm/dd/yyyy)'
  'This test creates a date string in dd/mm/yyyy format to'
  'simulate user input in a different format'

  Dim sExpected As String
  sExpected = Day(dteIn) & " / " & Month(dteIn) & " / " & Year(dteIn)
  Dim inputDate As String
  Dim dte As Date
  inputDate = Format(dteIn, "dd/mm/yyyy")
  dte = Format(inputDate, "dd/mm/yyyy")

  Debug.Assert sExpected = Day(dte) & " / " & Month(dte) & " / " & Year(dte)
  Debug.Print sExpected

End Sub

Answer 6

, .

, , <select> . / / .., "1 2009"

Then it doesn’t matter what your language settings are, you will get the date that the user intended.

Answer 7

Another way:

Public Enum abDateType
    abMDY
    abDMY
End Enum

Public Function MakeDate(ByVal dateString As String, ByVal dateType As abDateType, Optional delimiter As String = "/") As Date
    Dim strVals() As String
    Dim dtRtnVal As Date
    strVals = Split(dateString, delimiter)
    Select Case dateType
    Case abMDY
        dtRtnVal = DateSerial(strVals(2), strVals(0), strVals(1))
    Case abDMY
        dtRtnVal = DateSerial(strVals(2), strVals(1), strVals(0))
    Case Else
        Err.Raise vbObjectError, , "Unexpected date format."
    End Select
    MakeDate = dtRtnVal
End Function

Answer 8

You should talk to the date variable (not a formatted string) and then display the formatted value in the form using the user's regional settings, or enter data from the user to the date variable.