DateTime.ParseExact Equivalent for VB6? - datetime

Question

Does anyone know if there's an actual equivalent method in VB6 for .NET's DateTime.ParseExact() method? I've tried using DateSerial(), IsDate() and CDate(), but, due to all of VB6's "helpfulness", I'm coming up with some unexpected results.
To be more specific, I'm trying to parse a text string from user input to validate whether or not it's an actual date. As an example, I'll be using the date 8/25/16. The usual expected input may or may not have delimiters between the month, day and year, so it may be entered as 82516.
Here's a sample of the code that's not working as intended (the value of 82516 is stored in the TempStr variable):
If IsDate(Format(TempStr, "#/##/##")) And IsDate(Format(TempStr, "##/#/##")) Then
TempDate = #12:00:00 AM#
ElseIf IsDate(Format(TempStr, "#/##/##")) Then
TempDate = CDate(Format(Tempstr, "#/##/##"))
ElseIf IsDate(Format(TempStr, "##/#/##")) Then
TempDate = CDate(Format(TempStr, "##/#/##"))
End If
Using the stated value, the first condition triggers. Knowing how it works, I understand why it's happening (it's "rearranging" the month, day and year to try to match a valid date), but I'm really trying to get it to parse the date in a specific order. I know that .NET's DateTime.ParseExact() method would get me there, but I have to do this in VB6 (maintaining some legacy code).
I tried using DateSerial():
If DateSerial(CInt(Right(TempStr, 2)), CInt(Left(TempStr, 1)), CInt(Mid(TempStr, 2, 2))) > #12:00:00 AM# Then
If DateSerial(CInt(Right(TempStr, 2)), CInt(Left(TempStr, 2)), CInt(Mid(TempStr, 3, 1))) > #12:00:00 AM# Then
TempDate = #12:00:00 AM#
Else
TempDate = DateSerial(CInt(Right(TempStr, 2)), CInt(Left(TempStr, 1)), CInt(Mid(TempStr, 2, 2)))
End If
Else
If DateSerial(CInt(Right(TempStr, 2)), CInt(Left(TempStr, 2)), CInt(Mid(TempStr, 3, 1))) > #12:00:00 AM# Then
TempDate = DateSerial(CInt(Right(TempStr, 2)), CInt(Left(TempStr, 2)), CInt(Mid(TempStr, 3, 1)))
Else
TempDate = #12:00:00 AM#
End If
End If
But that also comes along with an automatic correction if the values for any of the parameters fall outside of the acceptable ranges.
I also tried the following variation of the above code:
If IsDate(Format(TempStr, "m/dd/yy")) And IsDate(Format(TempStr, "mm/d/yy")) Then
...
But the first test results in an entirely different value of 3/12/26, which is WAY off from the original input.
Is there any way to accurately emulate the .NET DateTime.ParseExact() method in VB6, or am I just going to have to toss these types of user input values out as invalid/ambiguous?

Answer 1

I will personally write a function for ensuring the correct date is returned -
First get the string/integer, break it down into chunks and add values to those chunks and return a combined date...
Option Explicit
Public Function MakeCorrectDate()
Dim xMakeDate As Long, xDay As Integer, xMonth As Integer, xYear As Integer, xCentury As Integer, strCorrectDate As String
''xMake as long because of size, strCorrectDate as string to allow the /...
xMakeDate = txtInput.Text
''Assuming the format will ALWAYS be the same days, months and year (12/20/16) and length is ALWAYS 6...
xDay = Left$(xMakeDate, 2)
xMonth = Mid$(xMakeDate, 3, 2)
xYear = Right(xMakeDate, 2)
''First get the correct part to 1900 or 2000...
If xYear = "00" Then
xCentury = 20
ElseIf xYear < 99 And xYear > 20 Then ''Year 2000 and year 2020
xCentury = 19
Else
xCentury = 20
End If
strCorrectDate = xDay & "/" & xMonth & "/" & xCentury & xYear
txtYear.Text = strCorrectDate
End Function
Private Sub cmdGetCorrectDate_Click()
If Not Len(txtInput.Text) = 6 Then
MsgBox "Incorrect information, must be 6 or more characters."
Exit Sub
Else
Call MakeCorrectDate
End If
End Sub
Private Sub txtInput_Change()
''Ensure the user adds only numerical text...
Dim WshShell As Object
Set WshShell = CreateObject("WScript.Shell")
If Not IsNumeric(txtInput.Text) Then
WshShell.SendKeys "{BackSpace}"
End If
End Sub

Answer 2

Okay, so here's what I've come up with as a solution for my current needs. Similar to what #Andre-Oosthuizen posted above, I've decided to drastically simplify the validation from what I was doing before. This series of functions requires the user to enter a six-digit date (two-digit month, two-digit day, and two-digit year). I don't believe the century is going to be a factor in this specific application, so I'm going to leave that test out.
This should be acceptable to our users as they've had similar restrictions in other systems. While I'd personally prefer a more "bullet-proof" solution (such as using a DatePicker or other manipulation of the UI), I think this is going to be the most effective for our environment.
'----------------------------------------------------------------------
' LostFocus event handler for the txtEffectiveDate TextBox.
' Test for a valid date when the user attempts to leave the field.
'----------------------------------------------------------------------
Private Sub txtEffectiveDate_LostFocus()
' *********************************************************************
' ** Don't have the event handler try to do any parsing. Just pass **
' ** the .Text value to the validation function. If a date comes **
' ** back, reformat it to "look" like a date and move on. Otherwise **
' ** pop up an "error" message and return focus to the TextBox for **
' ** the user to correct their input. **
' *********************************************************************
Dim TempDate As Date
TempDate = CheckForValidDate(Me.txtEffectiveDate.Text)
If TempDate > #12:00:00 AM# Then
' If a valid Date is returned, put the formatted String value
' into the TextBox and move on.
Me.txtEffectiveDate.Text = Format(TempDate, "mm/dd/yy")
Else
' If the Date value is not valid (#12:00:00 AM#), notify the
' user and refocus on the TextBox to force the user to
' correct the input before continuing.
MsgBox "The date you entered was not valid." & vbCrLf & vbCrLf & _
"Please enter two digits for the month, two digits for the day and" & vbCrLf & _
"two digits for the year." & vbCrLf & vbCrLf & _
"For example, today's date should be entered as either " & Format(Now, "mmddyy") & vbCrLf & _
" or " & Format(Now, "mm/dd/yy") & ".", _
vbOKOnly + vbExclamation, "INVALID INPUT FORMAT"
Me.txtEffectiveDate.SetFocus
Me.txtEffectiveDate.SelStart = 0
Me.txtEffectiveDate.SelLength = Len(Me.txtEffectiveDate.Text)
End If
End Sub
'----------------------------------------------------------------------
' Attempts to convert the String input to a Date value. If the String
' value is already a Date (i.e., "1/1/16" or similar), go ahead and
' assume that the user wants that date and return it as a Date value.
' Otherwise, strip any non-numeric characters and break apart the input
' to pass along for further validation.
'----------------------------------------------------------------------
Private Function CheckForValidDate(ByVal DateStr As String) As Date
Dim TempDate As Date
If IsDate(DateStr) Then
' If the String value is already in a date format,
' just return the Date value of the String.
TempDate = CDate(DateStr)
Else
Dim TempStr As String
Dim CurrentChar As String
Dim TempYear As Integer
Dim TempMonth As Integer
Dim TempDay As Integer
Dim I As Integer
' Strip all non-numeric characters to get a purely numeric string.
For I = 1 To Len(DateStr)
CurrentChar = Mid(DateStr, I, 1)
If IsNumeric(CurrentChar) Then
TempStr = TempStr & CurrentChar
End If
Next I
' The all-numeric string should be exactly six characters
' (for this application).
If Len(Trim(TempStr)) = 6 Then
Dim NewDateStr As String
' Break the numeric string into the component parts -
' Month, Day, and Year. At six characters, there should
' be two characters for each element.
TempMonth = CInt(Left(TempStr, 2))
TempDay = CInt(Mid(TempStr, 3, 2))
TempYear = CInt(Right(TempStr, 2))
' Now pass the individual values to the second part of
' the validation to ensure each of the individual values
' falls within acceptable ranges.
NewDateStr = GetValidDateString(TempMonth, TempDay, TempYear)
' If the returned String value is not empty, then convert
' it to a Date value for returning to the calling method
If Len(Trim(NewDateStr)) > 0 Then
TempDate = CDate(NewDateStr)
End If
End If
End If
CheckForValidDate = TempDate
End Function
'----------------------------------------------------------------------
' Using numeric values for Month, Day, and Year, attempt to build a
' valid Date in mm/dd/yy format.
'----------------------------------------------------------------------
Private Function GetValidDateString(ByVal intMonth As Integer, ByVal intDay As Integer, ByVal intYear As Integer) As String
Dim ReturnStr As String
ReturnStr = ""
If intMonth >= 1 And intMonth <= 12 Then
Select Case intMonth
Case 1, 3, 5, 7, 8, 10, 12
' January, March, May, July, August, October and December
' have 31 days.
If intDay >= 1 And intDay <= 31 Then
ReturnStr = intMonth & "/" & intDay & "/" & intYear
End If
Case 4, 6, 9, 11
' April, June, September and November
' have 30 days
If intDay >= 1 And intDay <= 30 Then
ReturnStr = intMonth & "/" & intDay & "/" & intYear
End If
Case 2
' Depending on whether it is a Leap Year (every four years),
' February may have 28 or 29 days.
If intYear Mod 4 = 0 Then
If intDay >= 1 And intDay <= 29 Then
ReturnStr = intMonth & "/" & intDay & "/" & intYear
End If
Else
If intDay >= 1 And intDay <= 28 Then
ReturnStr = intMonth & "/" & intDay & "/" & intYear
End If
End If
End Select
End If
' Return the recombined string to the calling function.
GetValidDateString = ReturnStr
End Function
There's still obviously going to be some room for error, but I believe this will solve the issue for now. It's not perfect, but hopefully we'll be able to move away from this VB6 system soon. Thank you for all of the ideas and suggestions. They were very helpful in narrowing down the best solution for this specific implementation.