Search code examples
vbaexcelexcel-2010

Find the current user language


How can I tell the current user language in a program?

I need this to show a form in an appropriate language.


Solution

  • My initial code (utilising this vbforum code) assumed that Windows and Excel share a common language - likely but not bulletproof.

    updated

    The revised code:

    1. Returns the Locale ID (LCID).
    2. Looks up the LCID from this msft link.
    3. Parses the LCID using a to get the language.

    Sample output on my machine below

    The code will let the user know if there are any errors in accessing the LCID website, or in parsing the country name.

    enter image description here

        Sub GetXlLang()
            Dim lngCode As Long
            lngCode = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
            MsgBox "Code is: " & lngCode & vbNewLine & GetTxt(lngCode)
        End Sub
    
        Function GetTxt(ByVal lngCode) As String
            Dim objXmlHTTP As Object
            Dim objRegex As Object
            Dim objRegMC As Object
            Dim strResponse As String
            Dim strSite As String
    
            Set objXmlHTTP = CreateObject("MSXML2.XMLHTTP")
            strSite = "http://msdn.microsoft.com/en-us/goglobal/bb964664"
    
            On Error GoTo ErrHandler
            With objXmlHTTP
                .Open "GET", strSite, False
                .Send
                If .Status = 200 Then strResponse = .ResponseText
            End With
            On Error GoTo 0
    
            strResponse = Replace(strResponse, "</td><td>", vbNullString)
            Set objRegex = CreateObject("vbscript.regexp")
            With objRegex
                .Pattern = "><td>([a-zA-Z- ]+)[A-Fa-f0-9]{4}" & lngCode                    
                If .Test(strResponse) Then
                    Set objRegMC = .Execute(strResponse)
                    GetTxt = objRegMC(0).submatches(0)
                Else
                    GetTxt = "Value not found from " & strSite
                End If
            End With
            Set objRegex = Nothing
            Set objXmlHTTP = Nothing
            Exit Function
    ErrHandler:
            If Not objXmlHTTP Is Nothing Then Set objXmlHTTP = Nothing
            GetTxt = strSite & " unable to be accessed"
        End Function