by Jeffry O'Neil ()
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 24th September 2002
Date Added: Mon 8th February 2021
Rating: (1 Votes)
Convert Dates without the Use of Separators
API Declarations
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