Search code examples
datetimevbscriptlocale

Convert date string value from U.S. to native Date with current locale <> U.S.?


As in Convert month name into number, I want to use DateValue to create a date from a date string. However, the string I have is guaranteed to be in U.S. format, while the PC executing the code is running on German locales.

Example: DateValue fails for "10 Oct 2013 06:50:19", it would succeed for "10 Okt 2013 06:50:19" since "October" is "Oktober" in German.

I.e. I need to get the date from a string in a country-specific date format that is different from the currert locale.

How can I do that without hardcoding an English-to-German month names translation table?

Also, the code should continue to work if the workstation executing the code is reconfigured for a different locale, so I am looking for a way to switch settings temporarily to get the U.S. date via DateValue, then switch back to the original setting. Of course, that code should among Windows flavours be portable...

The code currently having this problem is shown below. It tries to get a specific server´s system time by peeking into the http header. It fails if the current (short) month name in English is different in German.

Public Function GetServerTimeFromUrl (ByVal Url,ByRef DT)

    Dim HttpRequest: Set HttpRequest = CreateObject("Microsoft.XMLHttp")
    HttpRequest.Open "GET" , Url, false
    HttpRequest.Send

    Dim Result: Result=(HttpRequest.Status = 200)
    If Result then

        Dim DateS: DateS=HttpRequest.getResponseHeader ("Date")
        DateS=Right (DateS,Len (DateS)-InStr (DateS,",")-1)
        ' DateS has weekday removed

        DateS=Left (DateS,InStrRev (DateS," ")-1)
        ' DateS has timezone removed

        ' DateS now holds something like "09 Sep 2013 11:49:54" 
        Dim ServerTimeGMT: ServerTimeGMT=DateValue (DateS)+TimeValue (DateS)

        Dim Delta: Delta=CreateObject("WScript.Shell").RegRead("HKLM\SYSTEM\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")    
        ' Delta now holds "skew" value for time zone including DST
        DT=DateAdd("n", -Delta,ServerTimeGMT)
        Result=true
    End If
    GetServerTimeFromUrl=Result
End Function

Solution

  • You can use GetLocale and SetLocale to change the locale:

    This should work on a German system with a US date

    option explicit
    
    dim currentLocale
    currentLocale = GetLocale()
    
    SetLocale 1033       ' 1033 is the EN-US locale
    msgbox datevalue("9 Oct 2013 06:50:19")
    ' Output: 10/9/2013
    
    ' Put back the original locale
    SetLocale currentLocale
    

    Or the other way around; a German date on a US system

    SetLocale 1031       ' 1031 is the German locale
    msgbox datevalue("9 Okt 2013 06:50:19")
    ' Output: 09.10.2013