Multiple date formats

[gmaxey]

I'm looking for an efficient way to format a date in several different language formats.

For example

strDate = Format(Now, "MMMM dd, yyyy") 'English
strDate result = "September 21, 2014
strDate = Format(Now, "MMMM dd, yyyy") 'French
strDate result = "septembre 21, 2014
strDate = Format(Now, "MMMM dd, yyyy") 'Spanish
strDate result = "septeimbre 21, 2014

I've cobbled together a function that uses the Replace method to produce the correct month name, but was wondering if there was a better way. Thanks.

[gmayor]

I suppose it depends on what you are going to do with the date. If you are assigning it to a string then what you have is probably the most practical way forward (though French and Spanish and UK English use different date formats from the US). It would be a simple text string as far as the text is concerned without any language translation.

If you are inserting the date into the document then you can insert it directly into the current selection or range with the correct date/language format applied e.g.


Selection.InsertDateTime DateTimeFormat:="MMMM d, yyyy", _
InsertAsField:=False, _
DateLanguage:=wdEnglishUS 'US format
Selection.TypeParagraph
Selection.InsertDateTime DateTimeFormat:="d MMMM yyyy", _
InsertAsField:=False, _
DateLanguage:=wdFrench 'French format
Selection.TypeParagraph
Selection.InsertDateTime DateTimeFormat:="dd' de 'MMMM' de 'yyyy", _
InsertAsField:=False, _
DateLanguage:=wdSpanish ' Spanish format

[macropod]

If you're trying to work out what date formats a document uses, you might test the proofing language for either the 'Normal' Style or the current Style and/or the output from the various date formats. For example:

Sub Demo()
Dim Lng As Language
For Each Lng In Languages
If Lng.ID = Styles("Normal").LanguageID Then
MsgBox FormatDateTime(Date, vbLongDate) & vbCr & _
Format(Date, "Long Date") & vbCr & _
Format(Date, "Medium Date") & vbCr & _
Format(Date, "Short Date") & vbCr & _
FormatDateTime(Date, vbShortDate) & vbCr & _
FormatDateTime(Date, vbGeneralDate) & vbCr & _
Lng.ID & vbTab & Lng.NameLocal
Exit For
End If
Next
End Sub
Note that you can retrieve the system date formats using either FormatDateTime or Format. FormatDateTime is more generic, but lacks the 'medium' date format that Format can return.

[gmaxey]

Graham, Paul,

Thanks for your replies. I am aware of the InsertDateTime method and should have been clearer on my requirement. I am trying to define the label on a series of ribbon menu buttons, e.g., returnedVal = fcnGetFrench(Format(Now(), "d MMMM yyyy"))


Function fcnGetFrench(strIn As String) As String
Dim strFrench As String
strFrench = strIn
strFrench = Replace(strFrench, "Monday", "lundi")
strFrench = Replace(strFrench, "Tuesday", "mardi")
strFrench = Replace(strFrench, "Wednesday", "mercredi")
strFrench = Replace(strFrench, "Thursday", "jeudi")
strFrench = Replace(strFrench, "Friday", "vendredi")
strFrench = Replace(strFrench, "Saturday", "samedi")
strFrench = Replace(strFrench, "Sunday", "dimanche")
strFrench = Replace(strFrench, "January", "janvier")
strFrench = Replace(strFrench, "February", "février")
strFrench = Replace(strFrench, "March", "mars")
strFrench = Replace(strFrench, "April", "avril")
strFrench = Replace(strFrench, "May", "mai")
strFrench = Replace(strFrench, "June", "juin")
strFrench = Replace(strFrench, "July", "juillet")
strFrench = Replace(strFrench, "August", "août")
strFrench = Replace(strFrench, "September", "septembre")
strFrench = Replace(strFrench, "October", "octobre")
strFrench = Replace(strFrench, "November", "novembre")
strFrench = Replace(strFrench, "December", "décembre")
fcnGetFrench = strFrench
End Function

It works but was looking for a more direct way. Thanks!

[snb]

Sub M_snb()
With CreateObject("excel.application")
sn = Array(.Text(Date, "[$-40C]dddd d mmmm yyyy"), .Text(Date, "[$-40A]dddd d mmmm yyyy"), .Text(Date, "[$-816]dddd d mmmm yyyy"))
.Quit
End With
For Each it In sn
MsgBox it, , "snb"
Next
End Sub

[gmaxey]

Cryptic as usual but nice. However, this is a Word VBA forum and a Word VBA question. I have no idea if all users of the project will have Excel available.

[snb]

That's for you to decide whether to use the suggestion or not.
The nice thing of VBA is that is applies to all Office applications so you can take advantage of several applications (e.g. Outlook for sending email, Excel and Access for mailmerge, etc.)
As far as I know Word won't be sold as a stand-alone application, but always as part of Office (including Excel).

[gmaxey]

You are correct. I've decided not too.

[Paul_Hossler]

Greg -- Are you interesting in using the PC Control Panel settings to select month names, etc.?

I have an Excel module with API call to read and return values. I can check it out in Word if you're interested



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

'See http://msdn.microsoft.com/en-us/library/dd373739(v=VS.85).aspx for meaning of various constants.


I've also seen examples to set the WRS but never had reason to use it

Let me know

[gmaxey]

Paul,

I'm ashamed to say but I don't know if I really know what I interested in ;-). As I said, the goal is to define the control labels on ribbon menu based on a language previously defined by the user. For example, if the user select English the labels might look like:

9/23/2014
September 23, 2014
Tuesday, September 23, 2014
At Dallas, Tuesday, September 23, 2014
At New York, Tuesday, September, 2014

If the user chooses French as the language, then the menu will invalidate \refresh and the new labels would reflect the French equivalents.

My crude function works fine, and snb's code would also work. However the slight delay as Excel initializes might freak out some users and some users may not have Excel installed.

I suppose I was thinking that there might be some clean\cool way to temporarily reassign a users local settings (I think that is your drift) but didn't know if that was wise or not.

Bottom line, sure. If you think you have something that would work, then please share.

[Paul_Hossler]

Word seems to be harder to Internationalize that Excel. In Excel there's DateSerial which can localize dates

Application.International will also give you a few constants

This API and sample sub might be usable for your purposes, but you will need to build the properly formatted dates depending on country: 9/23/2014 in US and 23/09/2014 in others




Option Explicit
Private Declare Function GetLocaleInfoEx _
Lib "kernel32" ( _
ByVal lpLocaleName As Long, _
ByVal LCType As Long, _
ByVal lpLCData As Long, _
ByVal cchData As Long _
) As Long
Public Const LOCALE_USER_DEFAULT As Long = &H400
Public Const LOCALE_SENGLANGUAGE As Long = &H1001 ' English name of language
Public Const LOCALE_SENGCOUNTRY As Long = &H1002 ' English name of country
Public Const LOCALE_ILANGUAGE As Long = &H1
Public Const LOCALE_SLANGUAGE As Long = &H2
Public Const LOCALE_SABBREVLANGNAME As Long = &H3
Public Const LOCALE_SNATIVELANGNAME As Long = &H4 ' native name of language
Public Const LOCALE_ICOUNTRY As Long = &H5
Public Const LOCALE_SCOUNTRY As Long = &H6
Public Const LOCALE_SABBREVCTRYNAME As Long = &H7
Public Const LOCALE_SNATIVECTRYNAME As Long = &H8 ' native name of country
Public Const LOCALE_IDEFAULTLANGUAGE As Long = &H9
Public Const LOCALE_IDEFAULTCOUNTRY As Long = &HA
Public Const LOCALE_IDEFAULTCODEPAGE As Long = &HB
Public Const LOCALE_SLIST = &HC
Public Const LOCALE_IMEASURE As Long = &HD
Public Const LOCALE_SDECIMAL As Long = &HE
Public Const LOCALE_STHOUSAND As Long = &HF
Public Const LOCALE_SGROUPING As Long = &H10
Public Const LOCALE_IDIGITS As Long = &H11
Public Const LOCALE_ILZERO As Long = &H12
Public Const LOCALE_SNATIVEDIGITS As Long = &H13
Public Const LOCALE_SCURRENCY As Long = &H14 'local currency symbol
Public Const LOCALE_SINTLSYMBOL As Long = &H15 'intl symbol
Public Const LOCALE_SMONDECIMALSEP As Long = &H16 'decimal separator
Public Const LOCALE_SMONTHOUSANDSEP As Long = &H17 'thousand separator
Public Const LOCALE_SMONGROUPING As Long = &H18 'grouping
Public Const LOCALE_ICURRDIGITS As Long = &H19 '# local digits
Public Const LOCALE_IINTLCURRDIGITS As Long = &H1A '# intl digits
Public Const LOCALE_ICURRENCY As Long = &H1B 'pos currency mode
Public Const LOCALE_INEGCURR As Long = &H1C 'neg currency mode
Public Const LOCALE_SDATE As Long = &H1D
Public Const LOCALE_STIME As Long = &H1E
Public Const LOCALE_SSHORTDATE As Long = &H1F
Public Const LOCALE_SLONGDATE As Long = &H20
Public Const LOCALE_IDATE As Long = &H21
Public Const LOCALE_ILDATE As Long = &H22
Public Const LOCALE_ITIME As Long = &H23
Public Const LOCALE_ICENTURY As Long = &H24
Public Const LOCALE_ITLZERO As Long = &H25
Public Const LOCALE_IDAYLZERO As Long = &H26
Public Const LOCALE_IMONLZERO As Long = &H27
Public Const LOCALE_S1159 As Long = &H28
Public Const LOCALE_S2359 As Long = &H29
Public Const LOCALE_SDAYNAME1 As Long = &H2A 'long name for Monday
Public Const LOCALE_SDAYNAME2 As Long = &H2B 'long name for Tuesday
Public Const LOCALE_SDAYNAME3 As Long = &H2C 'long name for Wednesday
Public Const LOCALE_SDAYNAME4 As Long = &H2D 'long name for Thursday
Public Const LOCALE_SDAYNAME5 As Long = &H2E 'long name for Friday
Public Const LOCALE_SDAYNAME6 As Long = &H2F 'long name for Saturday
Public Const LOCALE_SDAYNAME7 As Long = &H30 'long name for Sunday
Public Const LOCALE_SABBREVDAYNAME1 As Long = &H31 'short name for Monday
Public Const LOCALE_SABBREVDAYNAME2 As Long = &H32 'short name for Tuesday
Public Const LOCALE_SABBREVDAYNAME3 As Long = &H33 'short name for Wednesday
Public Const LOCALE_SABBREVDAYNAME4 As Long = &H34 'short name for Thursday
Public Const LOCALE_SABBREVDAYNAME5 As Long = &H35 'short name for Friday
Public Const LOCALE_SABBREVDAYNAME6 As Long = &H36 'short name for Saturday
Public Const LOCALE_SABBREVDAYNAME7 As Long = &H37 'short name for Sunday
Public Const LOCALE_SMONTHNAME1 As Long = &H38
Public Const LOCALE_SMONTHNAME2 As Long = &H39
Public Const LOCALE_SMONTHNAME3 As Long = &H3A
Public Const LOCALE_SMONTHNAME4 As Long = &H3B
Public Const LOCALE_SMONTHNAME5 As Long = &H3C
Public Const LOCALE_SMONTHNAME6 As Long = &H3D
Public Const LOCALE_SMONTHNAME7 As Long = &H3E
Public Const LOCALE_SMONTHNAME8 As Long = &H3F
Public Const LOCALE_SMONTHNAME9 As Long = &H40
Public Const LOCALE_SMONTHNAME10 As Long = &H41
Public Const LOCALE_SMONTHNAME11 As Long = &H42
Public Const LOCALE_SMONTHNAME12 As Long = &H43
Public Const LOCALE_SABBREVMONTHNAME1 As Long = &H44
Public Const LOCALE_SABBREVMONTHNAME2 As Long = &H45
Public Const LOCALE_SABBREVMONTHNAME3 As Long = &H46
Public Const LOCALE_SABBREVMONTHNAME4 As Long = &H47
Public Const LOCALE_SABBREVMONTHNAME5 As Long = &H48
Public Const LOCALE_SABBREVMONTHNAME6 As Long = &H49
Public Const LOCALE_SABBREVMONTHNAME7 As Long = &H4A
Public Const LOCALE_SABBREVMONTHNAME8 As Long = &H4B
Public Const LOCALE_SABBREVMONTHNAME9 As Long = &H4C
Public Const LOCALE_SABBREVMONTHNAME10 As Long = &H4D
Public Const LOCALE_SABBREVMONTHNAME11 As Long = &H4E
Public Const LOCALE_SABBREVMONTHNAME12 As Long = &H4F
Public Const LOCALE_SPOSITIVESIGN As Long = &H50
Public Const LOCALE_SNEGATIVESIGN As Long = &H51
Public Const LOCALE_IPOSSIGNPOSN As Long = &H52 'pos sign position
Public Const LOCALE_INEGSIGNPOSN As Long = &H53 'neg sign position
Public Const LOCALE_IPOSSYMPRECEDES As Long = &H54 'mon sym precedes pos amt
Public Const LOCALE_IPOSSEPBYSPACE As Long = &H55 'mon sym sep by space from pos amt
Public Const LOCALE_INEGSYMPRECEDES As Long = &H56 'mon sym precedes neg amt
Public Const LOCALE_INEGSEPBYSPACE As Long = &H57 'mon sym sep by space from neg amt
Public Const LOCALE_FONTSIGNATURE As Long = &H58
Public Const LOCALE_SISO639LANGNAME As Long = &H59
Public Const LOCALE_SISO3166CTRYNAME As Long = &H5A
Public Const LOCALE_IGEOID As Long = &H5B
Public Const LOCALE_SNAME As Long = &H5C
Public Const LOCALE_SDURATION As Long = &H5D
Public Const LOCALE_SKEYBOARDSTOINSTALL = &H5E
'**
Public Const LOCALE_SSHORTESTDAYNAME1 As Long = &H60
Public Const LOCALE_SSHORTESTDAYNAME2 As Long = &H61
Public Const LOCALE_SSHORTESTDAYNAME3 As Long = &H62
Public Const LOCALE_SSHORTESTDAYNAME4 As Long = &H63
Public Const LOCALE_SSHORTESTDAYNAME5 As Long = &H64
Public Const LOCALE_SSHORTESTDAYNAME6 As Long = &H65
Public Const LOCALE_SSHORTESTDAYNAME7 As Long = &H66
Public Const LOCALE_SISO639LANGNAME2 As Long = &H67
Public Const LOCALE_SISO3166CTRYNAME2 As Long = &H68
Public Const LOCALE_SNAN As Long = &H69
Public Const LOCALE_SPOSINFINITY As Long = &H6A
Public Const LOCALE_SNEGINFINITY As Long = &H6B
Public Const LOCALE_SSCRIPTS As Long = &H6C
Public Const LOCALE_SPARENT As Long = &H6D
Public Const LOCALE_SCONSOLEFALLBACKNAME As Long = &H6E
'**
Public Const LOCALE_IREADINGLAYOUT As Long = &H70
Public Const LOCALE_INEUTRAL As Long = &H71
'**
Public Const LOCALE_INEGATIVEPERCENT As Long = &H74
Public Const LOCALE_IPOSITIVEPERCENT As Long = &H75
Public Const LOCALE_SPERCENT As Long = &H76
Public Const LOCALE_SPERMILLE As Long = &H77
Public Const LOCALE_SMONTHDAY As Long = &H78
Public Const LOCALE_SSHORTTIME As Long = &H79
Public Const LOCALE_SOPENTYPELANGUAGETAG As Long = &H7A
Public Const LOCALE_SSORTLOCALE As Long = &H7B
Public Const LOCALE_STIMEFORMAT As Long = &H1003
Public Const LOCALE_IDEFAULTANSICODEPAGE As Long = &H1004
Public Const LOCALE_ITIMEMARKPOSN As Long = &H1005
Public Const LOCALE_SYEARMONTH As Long = &H1006
Public Const LOCALE_SENGCURRNAME As Long = &H1007 'english name of currency
Public Const LOCALE_SNATIVECURRNAME As Long = &H1008 'native name of currency
Public Const LOCALE_ICALENDARTYPE As Long = &H1009
Public Const LOCALE_IPAPERSIZE As Long = &H100A
Public Const LOCALE_IOPTIONALCALENDAR As Long = &H100B
Public Const LOCALE_IFIRSTDAYOFWEEK As Long = &H100C
Public Const LOCALE_IFIRSTWEEKOFYEAR As Long = &H100D
Public Const LOCALE_SMONTHNAME13 As Long = &H100E
Public Const LOCALE_SABBREVMONTHNAME13 As Long = &H100F
Public Const LOCALE_INEGNUMBER As Long = &H1010
Public Const LOCALE_IDEFAULTMACCODEPAGE As Long = &H1011
Public Const LOCALE_IDEFAULTEBCDICCODEPAGE As Long = &H1012
Public Const LOCALE_SSORTNAME As Long = &H1013
Public Const LOCALE_IDIGITSUBSTITUTION As Long = &H1014
'http://msdn.microsoft.com/en-us/library/ee825488(v=cs.20).aspx
Function GetInfo(ByVal lInfo As Long, Optional LocaleName As String = "en-US") As String

Dim sLocaleName As String
Dim sRetBuffer As String
Dim nCharsRet As Long
sLocaleName = LocaleName & Chr$(0)
sRetBuffer = Space(256)

nCharsRet = GetLocaleInfoEx(StrPtr(sLocaleName), lInfo, StrPtr(sRetBuffer), Len(sRetBuffer) - 1)
GetInfo = Left$(sRetBuffer, nCharsRet)
End Function

Sub test()
'english
MsgBox GetInfo(LOCALE_SMONTHNAME1)
'French
MsgBox GetInfo(LOCALE_SMONTHNAME2, "fr-FR")
MsgBox GetInfo(LOCALE_SMONTHNAME3, "fr-FR")
MsgBox GetInfo(LOCALE_SMONTHNAME4, "fr-FR")
MsgBox GetInfo(LOCALE_SMONTHNAME5, "fr-FR")
'german
MsgBox GetInfo(LOCALE_SMONTHNAME6, "de-DE")
MsgBox GetInfo(LOCALE_SMONTHNAME7, "de-DE")
MsgBox GetInfo(LOCALE_SMONTHNAME8, "de-DE")
MsgBox GetInfo(LOCALE_SMONTHNAME9, "de-DE")
MsgBox GetInfo(LOCALE_SMONTHNAME10, "de-DE")
'date sep char
MsgBox GetInfo(LOCALE_SDATE, "en-US")
MsgBox GetInfo(LOCALE_SDATE, "fr-FR")
MsgBox GetInfo(LOCALE_SDATE, "de-DE")


End Sub

[gmaxey]

Paul,

Thanks. I could probably do something with that.

[gmaxey]

Paul,

While I don't think it can ever be perfect (just too many variables e.g, the first day of the month in a French date is 1st with the st superscripted) but this provides a pretty good result:


Option Explicit
Private Declare Function GetLocaleInfoEx Lib "kernel32" (ByVal lpLocaleName As Long, _
ByVal LCType As Long, ByVal lpLCData As Long, ByVal cchData As Long) As Long
Public Const LOCALE_SDAYNAME1 As Long = &H2A 'long name for Monday
Public Const LOCALE_SDAYNAME2 As Long = &H2B 'long name for Tuesday
Public Const LOCALE_SDAYNAME3 As Long = &H2C 'long name for Wednesday
Public Const LOCALE_SDAYNAME4 As Long = &H2D 'long name for Thursday
Public Const LOCALE_SDAYNAME5 As Long = &H2E 'long name for Friday
Public Const LOCALE_SDAYNAME6 As Long = &H2F 'long name for Saturday
Public Const LOCALE_SDAYNAME7 As Long = &H30 'long name for Sunday
Public Const LOCALE_SABBREVDAYNAME1 As Long = &H31 'short name for Monday
Public Const LOCALE_SABBREVDAYNAME2 As Long = &H32 'short name for Tuesday
Public Const LOCALE_SABBREVDAYNAME3 As Long = &H33 'short name for Wednesday
Public Const LOCALE_SABBREVDAYNAME4 As Long = &H34 'short name for Thursday
Public Const LOCALE_SABBREVDAYNAME5 As Long = &H35 'short name for Friday
Public Const LOCALE_SABBREVDAYNAME6 As Long = &H36 'short name for Saturday
Public Const LOCALE_SABBREVDAYNAME7 As Long = &H37 'short name for Sunday
Public Const LOCALE_SMONTHNAME1 As Long = &H38
Public Const LOCALE_SMONTHNAME2 As Long = &H39
Public Const LOCALE_SMONTHNAME3 As Long = &H3A
Public Const LOCALE_SMONTHNAME4 As Long = &H3B
Public Const LOCALE_SMONTHNAME5 As Long = &H3C
Public Const LOCALE_SMONTHNAME6 As Long = &H3D
Public Const LOCALE_SMONTHNAME7 As Long = &H3E
Public Const LOCALE_SMONTHNAME8 As Long = &H3F
Public Const LOCALE_SMONTHNAME9 As Long = &H40
Public Const LOCALE_SMONTHNAME10 As Long = &H41
Public Const LOCALE_SMONTHNAME11 As Long = &H42
Public Const LOCALE_SMONTHNAME12 As Long = &H43
Public Const LOCALE_SABBREVMONTHNAME1 As Long = &H44
Public Const LOCALE_SABBREVMONTHNAME2 As Long = &H45
Public Const LOCALE_SABBREVMONTHNAME3 As Long = &H46
Public Const LOCALE_SABBREVMONTHNAME4 As Long = &H47
Public Const LOCALE_SABBREVMONTHNAME5 As Long = &H48
Public Const LOCALE_SABBREVMONTHNAME6 As Long = &H49
Public Const LOCALE_SABBREVMONTHNAME7 As Long = &H4A
Public Const LOCALE_SABBREVMONTHNAME8 As Long = &H4B
Public Const LOCALE_SABBREVMONTHNAME9 As Long = &H4C
Public Const LOCALE_SABBREVMONTHNAME10 As Long = &H4D
Public Const LOCALE_SABBREVMONTHNAME11 As Long = &H4E
Public Const LOCALE_SABBREVMONTHNAME12 As Long = &H4F
Public Const LOCALE_SNAME As Long = &H5C

Function GetInfo(ByVal lInfo As Long, Optional LocaleName As String = "en-US") As String
'http://msdn.microsoft.com/en-us/library/ee825488(v=cs.20).aspx
Dim sLocaleName As String
Dim sRetBuffer As String
Dim nCharsRet As Long
sLocaleName = LocaleName & Chr$(0)
sRetBuffer = Space(256)
nCharsRet = GetLocaleInfoEx(StrPtr(sLocaleName), lInfo, StrPtr(sRetBuffer), Len(sRetBuffer) - 1)
GetInfo = Left$(sRetBuffer, nCharsRet)
GetInfo = Left(GetInfo, Len(GetInfo) - 1) 'Added GKM - printed result was displaying and odd AscW(0) character
lbl_Exit:
Exit Function
End Function

Sub DemoInsertDate()
'http://www.science.co.il/language/locale-codes.asp
Dim oInputDate As Date
oInputDate = Now - 22
Debug.Print fcnCreateInternationalDate(oInputDate, "DDDD, MMMM d, yyyy", "en-US")
Debug.Print fcnCreateInternationalDate(oInputDate, "DDDD, d MMMM, yyyy", "fr-CA")
Debug.Print fcnCreateInternationalDate(oInputDate, "DDDD, d MMMM, yyyy", "es-PA")
Debug.Print fcnCreateInternationalDate(oInputDate, "DDDD, d MMMM, yyyy", "de-DE")
Debug.Print fcnCreateInternationalDate(oInputDate, "DDD, MMMM d, yyyy", "en-US")
Debug.Print fcnCreateInternationalDate(oInputDate, "DDD, d MMMM, yyyy", "fr-CA")
Debug.Print fcnCreateInternationalDate(oInputDate, "DDD, d MMMM, yyyy", "es-PA")
Debug.Print fcnCreateInternationalDate(oInputDate, "DDD, d MMMM, yyyy", "de-DE")
Debug.Print fcnCreateInternationalDate(oInputDate, "DDD, MMM dd, yyyy", "en-US")
Debug.Print fcnCreateInternationalDate(oInputDate, "DDD, d MMM, yyyy", "fr-CA")
Debug.Print fcnCreateInternationalDate(oInputDate, "DDD, d MMM, yyyy", "es-PA")
Debug.Print fcnCreateInternationalDate(oInputDate, "DDD, d MMM, yyyy", "de-DE")
lbl_Exit:
Exit Sub
End Sub
Function fcnCreateInternationalDate(oDate As Date, strFormat As String, strLCID As String) As String
Dim strDate As String
Dim varWeekday
Dim varMonth
strDate = Format(oDate, strFormat)
If Left(UCase(strFormat), 5) = "DDDD," Then
varWeekday = Choose(Weekday(oDate), GetInfo(LOCALE_SDAYNAME7, _
GetInfo(LOCALE_SNAME)), GetInfo(LOCALE_SDAYNAME1, _
GetInfo(LOCALE_SNAME)), GetInfo(LOCALE_SDAYNAME2, _
GetInfo(LOCALE_SNAME)), GetInfo(LOCALE_SDAYNAME3, _
GetInfo(LOCALE_SNAME)), GetInfo(LOCALE_SDAYNAME4, _
GetInfo(LOCALE_SNAME)), GetInfo(LOCALE_SDAYNAME5, _
GetInfo(LOCALE_SNAME)), GetInfo(LOCALE_SDAYNAME6, _
GetInfo(LOCALE_SNAME)))
Select Case Weekday(oDate)
Case 1: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SDAYNAME7, strLCID))
Case 2: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SDAYNAME1, strLCID))
Case 3: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SDAYNAME2, strLCID))
Case 4: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SDAYNAME3, strLCID))
Case 5: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SDAYNAME4, strLCID))
Case 6: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SDAYNAME5, strLCID))
Case 7: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SDAYNAME6, strLCID))
End Select
ElseIf Left(UCase(strFormat), 4) = "DDD," Then
varWeekday = Choose(Weekday(oDate), GetInfo(LOCALE_SABBREVDAYNAME7, _
GetInfo(LOCALE_SNAME)), GetInfo(LOCALE_SABBREVDAYNAME1, _
GetInfo(LOCALE_SNAME)), GetInfo(LOCALE_SABBREVDAYNAME2, _
GetInfo(LOCALE_SNAME)), GetInfo(LOCALE_SABBREVDAYNAME3, _
GetInfo(LOCALE_SNAME)), GetInfo(LOCALE_SABBREVDAYNAME4, _
GetInfo(LOCALE_SNAME)), GetInfo(LOCALE_SABBREVDAYNAME5, _
GetInfo(LOCALE_SNAME)), GetInfo(LOCALE_SABBREVDAYNAME6, _
GetInfo(LOCALE_SNAME)))
Select Case Weekday(oDate)
Case 1: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SABBREVDAYNAME7, strLCID))
Case 2: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SABBREVDAYNAME1, strLCID))
Case 3: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SABBREVDAYNAME2, strLCID))
Case 4: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SABBREVDAYNAME3, strLCID))
Case 5: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SABBREVDAYNAME4, strLCID))
Case 6: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SABBREVDAYNAME5, strLCID))
Case 7: strDate = Replace(strDate, varWeekday, GetInfo(LOCALE_SABBREVDAYNAME6, strLCID))
End Select
End If
If InStr(UCase(strFormat), "MMMM") > 0 Then
varMonth = Choose(Month(oDate), GetInfo(LOCALE_SMONTHNAME1, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SMONTHNAME2, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SMONTHNAME3, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SMONTHNAME4, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SMONTHNAME5, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SMONTHNAME6, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SMONTHNAME7, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SMONTHNAME8, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SMONTHNAME9, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SMONTHNAME10, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SMONTHNAME11, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SMONTHNAME12, GetInfo(LOCALE_SNAME)))
Select Case Month(oDate)
Case 1: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SMONTHNAME1, strLCID))
Case 2: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SMONTHNAME2, strLCID))
Case 3: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SMONTHNAME3, strLCID))
Case 4: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SMONTHNAME4, strLCID))
Case 5: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SMONTHNAME5, strLCID))
Case 6: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SMONTHNAME6, strLCID))
Case 7: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SMONTHNAME7, strLCID))
Case 8: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SMONTHNAME8, strLCID))
Case 9: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SMONTHNAME9, strLCID))
Case 10: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SMONTHNAME10, strLCID))
Case 11: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SMONTHNAME11, strLCID))
Case 12: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SMONTHNAME12, strLCID))
End Select
ElseIf InStr(UCase(strFormat), "MMMM") > 0 Then
varMonth = Choose(Month(oDate), GetInfo(LOCALE_SABBREVMONTHNAME1, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SABBREVMONTHNAME2, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SABBREVMONTHNAME3, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SABBREVMONTHNAME4, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SABBREVMONTHNAME5, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SABBREVMONTHNAME6, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SABBREVMONTHNAME7, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SABBREVMONTHNAME8, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SABBREVMONTHNAME9, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SABBREVMONTHNAME10, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SABBREVMONTHNAME11, GetInfo(LOCALE_SNAME)), _
GetInfo(LOCALE_SABBREVMONTHNAME12, GetInfo(LOCALE_SNAME)))
Select Case Month(oDate)
Case 1: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SABBREVMONTHNAME1, strLCID))
Case 2: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SABBREVMONTHNAME2, strLCID))
Case 3: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SABBREVMONTHNAME3, strLCID))
Case 4: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SABBREVMONTHNAME4, strLCID))
Case 5: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SABBREVMONTHNAME5, strLCID))
Case 6: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SABBREVMONTHNAME6, strLCID))
Case 7: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SABBREVMONTHNAME7, strLCID))
Case 8: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SABBREVMONTHNAME8, strLCID))
Case 9: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SABBREVMONTHNAME9, strLCID))
Case 10: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SABBREVMONTHNAME10, strLCID))
Case 11: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SABBREVMONTHNAME11, strLCID))
Case 12: strDate = Replace(strDate, varMonth, GetInfo(LOCALE_SABBREVMONTHNAME12, strLCID))
End Select
End If
'ActiveDocument.Range.InsertAfter strDate & vbCr
fcnCreateInternationalDate = strDate
lbl_Exit:
Exit Function
End Function

[Paul_Hossler]

You could read the date formats directly and do the replacing

This is a little different in that it only uses the system long and short date formats, but might give you some ideas



Function GetInfo(ByVal lInfo As Long, Optional LocaleName As String = "en-US") As String
'http://msdn.microsoft.com/en-us/library/ee825488(v=cs.20).aspx
Dim sLocaleName As String
Dim sRetBuffer As String
Dim nCharsRet As Long
sLocaleName = LocaleName & Chr$(0)
sRetBuffer = Space(256)
nCharsRet = GetLocaleInfoEx(StrPtr(sLocaleName), lInfo, StrPtr(sRetBuffer), Len(sRetBuffer) - 1)
GetInfo = Left$(sRetBuffer, nCharsRet)
GetInfo = Left(GetInfo, Len(GetInfo) - 1) 'Added GKM - printed result was displaying and odd AscW(0) character
lbl_Exit:
Exit Function
End Function

Sub DemoInsertDate()
'http://www.science.co.il/language/locale-codes.asp
Dim oInputDate As Date
oInputDate = Now - 22
Debug.Print fcnCreateInternationalDate(oInputDate, False, "en-US")
Debug.Print fcnCreateInternationalDate(oInputDate, True, "en-US")

Debug.Print fcnCreateInternationalDate(oInputDate, False, "fr-CA")
Debug.Print fcnCreateInternationalDate(oInputDate, True, "fr-CA")

Debug.Print fcnCreateInternationalDate(oInputDate, False, "de-DE")
Debug.Print fcnCreateInternationalDate(oInputDate, True, "de-DE")
End Sub
Function fcnCreateInternationalDate(oDate As Date, Optional bShortFormat As Boolean = True, Optional strLCID As String = "en-US") As String
Dim strDate As String
Dim iDOW As Long, iMOY As Long, iDay As Long, iYear As Long
Dim sDOW As String, sMOY As String

iDOW = Weekday(oDate)
iDay = Day(oDate)
iMOY = Month(oDate)
iYear = Year(oDate)


If bShortFormat Then
strDate = GetInfo(LOCALE_SSHORTDATE, strLCID)
sDOW = GetInfo(LOCALE_SABBREVDAYNAME1 + iDOW - 1, strLCID)
sMOY = GetInfo(LOCALE_SABBREVMONTHNAME1 + iMOY - 1, strLCID)

Else
strDate = GetInfo(LOCALE_SLONGDATE, strLCID)
sDOW = GetInfo(LOCALE_SDAYNAME1 + iDOW - 1, strLCID)
sMOY = GetInfo(LOCALE_SMONTHNAME1 + iMOY - 1, strLCID)
End If

strDate = UCase(strDate)

If InStr(strDate, "DDDD") > 0 Then
strDate = Replace(strDate, "DDDD", sDOW)
ElseIf InStr(strDate, "DDD") > 0 Then
strDate = Replace(strDate, "DDD", sDOW)
End If

If InStr(strDate, "MMMM") > 0 Then
strDate = Replace(strDate, "MMMM", sMOY)
ElseIf InStr(strDate, "MMM") > 0 Then
strDate = Replace(strDate, "MMM", sMOY)
ElseIf InStr(strDate, "MM") > 0 Then
strDate = Replace(strDate, "MM", Format(iMOY, "0#"))
ElseIf InStr(strDate, "M") > 0 Then
strDate = Replace(strDate, "M", Format(iMOY, "##"))
End If

If InStr(strDate, "DD") > 0 Then
strDate = Replace(strDate, "DD", Format(iDay, "0#"))
ElseIf InStr(strDate, "D") > 0 Then
strDate = Replace(strDate, "D", Format(iDay, "##"))
End If

If InStr(strDate, "YYYY") > 0 Then
strDate = Replace(strDate, "YYYY", Format(iYear, "####"))
ElseIf InStr(strDate, "YY") > 0 Then
strDate = Replace(strDate, "YY", Right(Format(iYear, "####"), 2))
End If


fcnCreateInternationalDate = strDate
End Function