Atlanta Custom Software Development 

 
   Search        Code/Page
 

User Login
Email

Password

 

Forgot the Password?
Services
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
Programming
  Database
Automation
OS/Networking
Graphics
Links
Tools
» Regular Expr Tester
» Free Tools

FormatInternationalDate - Retrieving a date in an international format

Total Hit ( 3503)

Rate this article:     Poor     Excellent 

 Submit Your Question/Comment about this article

Rating


 



Click here to copy the following block
' *** International date handler
Public Enum eDateLocale
  edlArabic = &H401
  edlDanish = &H406
  edlGerman = &H407
  edlSwissGerman = &H807
  edlAmerican = &H409
  edlBritish = &H809
  edlAustralian = &HC09
  edlSpanish = &H40A
  edlFinnish = &H40B
  edlFrench = &H40C
  edlFrenchCanadian = &HC0C
  edlHebrew = &H40D
  edlItalian = &H410
  edlDutch = &H413
  edlDutchPreferred = &H13
  edlDutchBelgian = &H813
  edlNorskBokmal = &H414
  edlNorskNynorsk = &H814
  edlPortBrazil = &H416
  edlPortIberian = &H816
  edlSwedish = &H41D
  edlCatalan = &H403
  edlRussian = &H419
  edlCzech = &H405
  edlHungarian = &H40E
  edlPolish = &H415
  edlJapanese = &H411
  edlKorean = &H412
  edlTaiwan = &H404
  edlChina = &H804
  edlTurkish = &H41F
  edlGreek = &H408
  edlBasque = &H42D
  edlSlovenian = &H424
  edlMalaysian = &H43E
  edlAfrikaans = &H436
  edlBulgarian = &H402
  edlCroatian = &H41A
  edlEstonian = &H425
  edlLatvian = &H426
  edlLithuanian = &H427
  edlMacedonian = &H42F
  edlRomanian = &H418
  edlSerbianCyrillic = &HC1A
  edlSerbianLatin = &H81A
  edlByelorussian = &H423
  edlSlovak = &H41B
  edlUkrainian = &H422
  edlIcelandic = &H40F
  edlVietnamese = &H42A
  edlThai = &H41E
End Enum

Private Const LOCALE_SDAYNAME1 = &H2A
Private Const LOCALE_SDAYNAME2 = &H2B
Private Const LOCALE_SDAYNAME3 = &H2C
Private Const LOCALE_SDAYNAME4 = &H2D
Private Const LOCALE_SDAYNAME5 = &H2E
Private Const LOCALE_SDAYNAME6 = &H2F
Private Const LOCALE_SDAYNAME7 = &H30
Private Const LOCALE_SMONTHNAME1 = &H38
Private Const LOCALE_SMONTHNAME2 = &H39
Private Const LOCALE_SMONTHNAME3 = &H3A
Private Const LOCALE_SMONTHNAME4 = &H3B
Private Const LOCALE_SMONTHNAME5 = &H3C
Private Const LOCALE_SMONTHNAME6 = &H3D
Private Const LOCALE_SMONTHNAME7 = &H3E
Private Const LOCALE_SMONTHNAME8 = &H3F
Private Const LOCALE_SMONTHNAME9 = &H40
Private Const LOCALE_SMONTHNAME10 = &H41
Private Const LOCALE_SMONTHNAME11 = &H42
Private Const LOCALE_SMONTHNAME12 = &H43

Private Declare Function IsValidLocale Lib "kernel32" (ByVal Locale As Long, _
  ByVal dwFlags As Long) As Boolean
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" _
  (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, _
  ByVal cchData As Long) As Long
Private Declare Function GetUserDefLCID Lib "kernel32" Alias _
  "GetUserDefaultLCID" () As Long


' **********************************************************************
' * Programmer Name : WAty Thierry
' * E-Mail      : waty.thierry@vbdiamond.com
' * Web Site     : http://www.d2dsources.com
' * Date       : 07/15/2003
' **********************************************************************
' * Comments     : Retrieve the date from an international long Format
' *
' * Retrieve the date from an international long format
' * Debug.Print FormatInternationalDate("11 juillet 2003") ' => 2003/07/11,
' * Debug.Print FormatInternationalDate("11-july-2003", , "-") ' => 2003/07/11,
' * Debug.Print FormatInternationalDate("11 diciembre 2003") ' => 2003/12/11
' *
' **********************************************************************

Function FormatInternationalDate(sDate As String, Optional sRequiredFormat As _
  String = "YYYY/MM/DD", Optional sDelimiter As Variant = " ") As String
  On Error GoTo ERROR_FormatInternationalDate
 
  Dim sTmp    As String
  Dim oSplit()  As String
 
  Dim sDay    As String
  Dim sMonth   As String
  Dim sYear   As String
 
  Dim colLanguage As New Collection
 
  Dim oLanguage As Variant
  Dim nLanguage As eDateLocale
 
  ' *** Some init
  sDay = vbNullString
  sMonth = vbNullString
  sYear = vbNullString
 
  ' *** Get the date
  sTmp = Trim$(sDate)
 
  ' *** Clean a bit the date with double delimiters
  Do While InStr(sTmp, sDelimiter & sDelimiter) > 0
   sTmp = Replace(sTmp, sDelimiter & sDelimiter, sDelimiter, , , _
     vbTextCompare)
  Loop
 
  ' *** Split the date
  oSplit = Split(sTmp, sDelimiter)
 
  ' *** Check if we have 3 parts
  If UBound(oSplit) = 2 Then
   ' *** Assuming the day is the first of the array
   sDay = oSplit(0)
   ' *** Assuming the month is the second of the array
   sMonth = oSplit(1)
   ' *** Assuming the year is the third of the array
   sYear = oSplit(2)
  Else
   sMonth = sDate
  End If
 
  ' *** Create the collection of languages
  colLanguage.Add "L" & edlFrench ' *** &H40C
  colLanguage.Add "L" & edlFrenchCanadian ' *** &HC0C
  colLanguage.Add "L" & edlGerman ' *** &H407
  colLanguage.Add "L" & edlSpanish ' *** &H40A
  colLanguage.Add "L" & edlItalian ' *** &H410
  colLanguage.Add "L" & edlDutch ' *** &H413
  colLanguage.Add "L" & edlSwedish ' *** &H41D
  colLanguage.Add "L" & edlDanish ' *** &H406
  colLanguage.Add "L" & edlArabic ' *** &H401
  colLanguage.Add "L" & edlSwissGerman ' *** &H807
  colLanguage.Add "L" & edlAmerican ' *** &H409
  colLanguage.Add "L" & edlBritish ' *** &H809
  colLanguage.Add "L" & edlAustralian ' *** &HC09
  colLanguage.Add "L" & edlFinnish ' *** &H40B
  colLanguage.Add "L" & edlHebrew ' *** &H40D
  colLanguage.Add "L" & edlDutchPreferred ' *** &H13
  colLanguage.Add "L" & edlDutchBelgian ' *** &H813
  colLanguage.Add "L" & edlNorskBokmal ' *** &H414
  colLanguage.Add "L" & edlNorskNynorsk ' *** &H814
  colLanguage.Add "L" & edlPortBrazil ' *** &H416
  colLanguage.Add "L" & edlPortIberian ' *** &H816
  colLanguage.Add "L" & edlCatalan ' *** &H403
  colLanguage.Add "L" & edlRussian ' *** &H419
  colLanguage.Add "L" & edlCzech ' *** &H405
  colLanguage.Add "L" & edlHungarian ' *** &H40E
  colLanguage.Add "L" & edlPolish ' *** &H415
  colLanguage.Add "L" & edlJapanese ' *** &H411
  colLanguage.Add "L" & edlKorean ' *** &H412
  colLanguage.Add "L" & edlTaiwan ' *** &H404
  colLanguage.Add "L" & edlChina ' *** &H804
  colLanguage.Add "L" & edlTurkish ' *** &H41F
  colLanguage.Add "L" & edlGreek ' *** &H408
  colLanguage.Add "L" & edlBasque ' *** &H42D
  colLanguage.Add "L" & edlSlovenian ' *** &H424
  colLanguage.Add "L" & edlMalaysian ' *** &H43E
  colLanguage.Add "L" & edlAfrikaans ' *** &H436
  colLanguage.Add "L" & edlBulgarian ' *** &H402
  colLanguage.Add "L" & edlCroatian ' *** &H41A
  colLanguage.Add "L" & edlEstonian ' *** &H425
  colLanguage.Add "L" & edlLatvian ' *** &H426
  colLanguage.Add "L" & edlLithuanian ' *** &H427
  colLanguage.Add "L" & edlMacedonian ' *** &H42F
  colLanguage.Add "L" & edlRomanian ' *** &H418
  colLanguage.Add "L" & edlSerbianCyrillic ' *** &HC1A
  colLanguage.Add "L" & edlSerbianLatin ' *** &H81A
  colLanguage.Add "L" & edlByelorussian ' *** &H423
  colLanguage.Add "L" & edlSlovak ' *** &H41B
  colLanguage.Add "L" & edlUkrainian ' *** &H422
  colLanguage.Add "L" & edlIcelandic ' *** &H40F
  colLanguage.Add "L" & edlVietnamese ' *** &H42A
  colLanguage.Add "L" & edlThai ' *** &H41E

  ' *** Replace the months for the current date
  nLanguage = GetUserDefLCID()
  sMonth = ReplaceAllMonths(sMonth, nLanguage)

  If IsNumeric(sMonth) = False Then
   ' *** Replace the months for all locale
   For Each oLanguage In colLanguage
     nLanguage = Replace(oLanguage, "L", vbNullString)
     sMonth = ReplaceAllMonths(sMonth, nLanguage)
   
     If IsNumeric(sMonth) Then Exit For
   Next
  End If
 
  ' *** Create the date at the right format
  If IsNumeric(sDay) And IsNumeric(sMonth) And IsNumeric(sYear) Then
   FormatInternationalDate = Format(DateSerial(sYear, sMonth, sDay), _
     sRequiredFormat)
  Else
   FormatInternationalDate = vbNullString
  End If

EXIT_FormatI


Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )


Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  BlogsZappySys

© 2008 BinaryWorld LLC. All rights reserved.