' *** International date handlerPublic 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 = &H41EEnd EnumPrivate Const LOCALE_SDAYNAME1 = &H2APrivate Const LOCALE_SDAYNAME2 = &H2BPrivate Const LOCALE_SDAYNAME3 = &H2CPrivate Const LOCALE_SDAYNAME4 = &H2DPrivate Const LOCALE_SDAYNAME5 = &H2EPrivate Const LOCALE_SDAYNAME6 = &H2FPrivate Const LOCALE_SDAYNAME7 = &H30Private Const LOCALE_SMONTHNAME1 = &H38Private Const LOCALE_SMONTHNAME2 = &H39Private Const LOCALE_SMONTHNAME3 = &H3APrivate Const LOCALE_SMONTHNAME4 = &H3BPrivate Const LOCALE_SMONTHNAME5 = &H3CPrivate Const LOCALE_SMONTHNAME6 = &H3DPrivate Const LOCALE_SMONTHNAME7 = &H3EPrivate Const LOCALE_SMONTHNAME8 = &H3FPrivate Const LOCALE_SMONTHNAME9 = &H40Private Const LOCALE_SMONTHNAME10 = &H41Private Const LOCALE_SMONTHNAME11 = &H42Private Const LOCALE_SMONTHNAME12 = &H43Private Declare Function IsValidLocale Lib "kernel32" (ByVal Locale As Long, _    ByVal dwFlags As Long) As BooleanPrivate Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" _    (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, _    ByVal cchData As Long) As LongPrivate Declare Function GetUserDefLCID Lib "kernel32" Alias _    "GetUserDefaultLCID" () As Long' **********************************************************************' * Programmer Name  : WAty Thierry' * E-Mail           : [email protected]' * 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 IfEXIT_FormatInternationalDate:   Exit FunctionERROR_FormatInternationalDate:   FormatInternationalDate = vbNullString   Resume EXIT_FormatInternationalDate   End Function' *********************************************************************' * Author           : Waty Thierry' * E-Mail           : [email protected]' * Web Site         : http://www.d2dsources.com' * Date             : 07/11/2003' * Procedure Name   : ReplaceAllMonths' * Purpose          : Replace the all the months name for a locale' * Parameters       :' *                    sDate As String        Date to work' *                    eLocale As eDateLocale Locale to change' **********************************************************************' * Comments         :' * Replace the all the months name for a locale' **********************************************************************Private Function ReplaceAllMonths(sDate As String, eLocale As eDateLocale) As _    String   Dim nI         As Integer   Dim sTmp       As String      sTmp = sDate      For nI = 1 To 12      sTmp = ReplaceMonth(sTmp, eLocale, nI)   Next      ReplaceAllMonths = sTmpEnd Function' ********************************************************************' * Author           : Waty Thierry' * E-Mail           : [email protected]' * Web Site         : http://www.d2dsources.com' * Date             : 07/11/2003' * Procedure Name   : ReplaceMonth' * Purpose          : Replace the month name for a given month and Locale' * Parameters       :' *                    sDate As String          Date to work' *                    eLocale As eDateLocale   Locale to use' *                    nMonth As Integer        Month to replace' *********************************************************************' * Comments         :' * Replace the month name for a given month and locale' **********************************************************************   Private Function ReplaceMonth(sDate As String, eLocale As eDateLocale, _    nMonth As Integer) As String   If (nMonth < 1) And (nMonth > 12) Then      ReplaceMonth = sDate   Else      Dim nRet             As Long      Dim lpLCDateVar      As String      Dim sTmp             As String      Dim nPos             As Integer            nRet = GetLocaleInfo(eLocale, LOCALE_SMONTHNAME1 + nMonth - 1, _          lpLCDateVar, 0)      sTmp = String$(nRet, 0)         nRet = GetLocaleInfo(eLocale, LOCALE_SMONTHNAME1 + nMonth - 1, sTmp, nRet)      nPos = InStr(sTmp, Chr$(0))      sTmp = Left$(sTmp, nPos - 1)            ReplaceMonth = Replace(sDate, sTmp, nMonth, , , vbTextCompare)   End IfEnd Function' Visit the author's VB Diamond (www.vbdiamond.com) site for many more VB6 ' routines