[AccessD] All-In-One Date format Function:

Hi Robert --

I'd suppose that removing delimiters could produce incorrect output, e.g.

1-12-9 without delimiters would be 1129 - is the latter:

a) January 12, 2009 or
b) November 2, 2009 or
c) November 29, 2009

?

--
Shamil

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Robert
Sent: Thursday, October 22, 2009 4:46 PM
To: 'Access Developers discussion and problem solving'
Subject: Re: [AccessD] All-In-One Date format Function:

Shamil,
  Thank you very much for your "dirty code", yours "Looks" much cleaner then
my first run at it..  I will work with it..  This is what I came up with..
First Rev. still need to clean it up....

Public Function FormatCCDate(dCCDate As String) As String
Dim dLastDay                        As Date
Dim dDate                           As String
Dim sFirstPart                      As String
Dim sSecondPart                     As String
Dim sThirdPart                      As String
Dim dFinalDate                      As Date
Dim lStr                            As Long

   On Error GoTo HandleErr
If Nz(dCCDate, "") <> "" Then
   dDate = dCCDate
   'Strips everything but the numbers
   dDate = varNumericPart(dDate)
   
  Select Case Len(dDate)
    Case 3 '909 entries would format to 09 31 09  31 would automaticly be
entered
      sFirstPart = 0 & Left(dDate, 1)
      sThirdPart = Right(dDate, 2)
      sSecondPart = Mid(DateSerial(Year(CDate(sFirstPart & 1 & sThirdPart)),
Month(dDate) + 1, 0), 3, 2)
      
      dFinalDate = Format(sFirstPart & "/" & sSecondPart & "/" & sThirdPart,
"Short Date")
 
    Case 4  '0909 entries would format to 09 31 09  31 would automaticly be
entered
      sFirstPart = Left(dDate, 2)
      sThirdPart = Right(dDate, 2)
      sSecondPart = Mid(DateSerial(Year(CDate(sFirstPart & 1 & sThirdPart)),
Month(dDate) + 1, 0), 3, 2)
      
      dFinalDate = Format(sFirstPart & "/" & sSecondPart & "/" & sThirdPart,
"Short Date")
    

    Case 5 '92109 entries would format to 09 21 09
      sFirstPart = 0 & Left(dDate, 1)
      sThirdPart = Right(dDate, 2)
      sSecondPart = Mid(dDate, 2, 2)
      
      dFinalDate = Format(sFirstPart & "/" & sSecondPart & "/" & sThirdPart,
"Short Date")
      

    Case 6 '092109 entries would format to 09 21 09
      sFirstPart = Left(dDate, 2)
      sThirdPart = Right(dDate, 2)
      sSecondPart = Mid(dDate, 3, 2)
      
      dFinalDate = Format(sFirstPart & "/" & sSecondPart & "/" & sThirdPart,
"Short Date")
      
    Case 7  '9212009 entries would format to 09 21 2009
      sFirstPart = 0 & Left(dDate, 1)
      sThirdPart = Right(dDate, 4)
      sSecondPart = Mid(dDate, 2, 2)
      
      dFinalDate = Format(sFirstPart & "/" & sSecondPart & "/" & sThirdPart,
"Short Date")
      
    Case 8  '09212009 entries would format to 09 21 2009
      sFirstPart = Left(dDate, 2)
      sThirdPart = Right(dDate, 4)
      sSecondPart = Mid(dDate, 3, 2)
      
      dFinalDate = Format(sFirstPart & "/" & sSecondPart & "/" & sThirdPart,
"Short Date")
    Case Else
       dFinalDate = Empty
  End Select

 If dFinalDate = "12:00:00 AM" Then
   MsgBox " Sorry, Could not determine date formatting. Please enter a valid
date ", , "Problem Box"
 Else
   FormatCCDate = dFinalDate
 End If
End If

ExitHere:
On Error Resume Next

    Exit Function
HandleErr:
  Select Case Err.Number
   Case Else
      'MsgBox Err.BuildError("basServiceOrder:FormatCCDate"), vbCritical,
"Un-Expected Error"
       MsgBox "There has been an error in Procedure:
basServiceOrder:FormatCCDate " & vbCrLf & _
          "Error Number: " & Err.Number & vbCrLf & "Error Description: " &
Err.Description & " On Line: " & Erl() & vbCrLf & _
          " Please Contact " & "The SoftwareVendor" & " for more help
regarding this error. ", vbCritical, "Un-Expected Error"
       Call ErrorRecordSystem(Err.Number, Err.Description & " On Line: " &
Erl(), Now, "Un-Expected Error In Proc; " & "basServiceOrder:FormatCCDate",
CurrentUser, Err)
       Resume ExitHere
End Select
End Function

<<< snip >>>
 

__________ Information from ESET NOD32 Antivirus, version of virus signature
database 4533 (20091022) __________

The message was checked by ESET NOD32 Antivirus.

http://www.esetnod32.ru