Sometimes the user forgets to enter a date with date separators. A good way to deal with this is to correct the users mistake instead of forcing the user to enter the date again. To correct the date, take the locale date format sting into consideration. You can retrieve it by using API:
Private Const LOCALE_SSHORTDATE = &H1F Private Const LOCALE_USER_DEFAULT As Long = &H400 Private Declare Function GetLocaleInfo Lib "KERNEL32" _ Alias "GetLocaleInfoA" (ByVal lLocale As Long, _ ByVal lLocaleType As Long, _ ByVal sLCData As String, _ ByVal lBufferLength As Long) As Long Public Function GetDateFormat() As String Dim lReturn As Long Dim sBuffer As String Dim lBufferLength As Long lBufferLength = 128 sBuffer = String$(lBufferLength, 0) lReturn = GetLocaleInfo(LOCALE_USER_DEFAULT, _LOCALE_SSHORTDATE, sBuffer, lBufferLength) If lReturn > 0 Then GetDateFormat = Left$(sBuffer, lReturn - 1) End If End Function Public Function FixDate(Value As String) As Date Dim Index As Long Dim Position As Long Dim Result As String If IsDate(Value) Then FixDate = CDate(Value) ElseIf IsNumeric(Value) Then Result = LCase$(GetDateFormat) If Value Like "######" Then If InStr(Result, "yyyy") Then Result = Replace(Result, "yyyy", "yy") End If ElseIf Value Like "########" Then If InStr(Result, "yyyy") = 0 Then Result = Replace(Result, "yy", "yyyy") End If Else Exit Function End If For Index = 1 To Len(Result) Select Case Mid$(Result, Index, 1) Case "y", "m", "d" Position = Position + 1 Mid$(Result, Index, 1) = Mid$(Value, _Position, 1) End Select Next If IsDate(Result) Then FixDate = CDate(Result) End If End If End Function
