Convert Dates without the Use of Separators

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
Share the Post:
Share on facebook
Share on twitter
Share on linkedin


Recent Articles: