Find the current user language
This is another variation of the code posted by brettdj
Sub Test_GetLocale_UDF()
Dim lngCode As Long
lngCode = Application.LanguageSettings.LanguageID(msoLanguageIDUI)
MsgBox "Code Is: " & lngCode & vbNewLine & GetLocale(lngCode)
End Sub
Function GetLocale(ByVal lngCode) As String
Dim html As Object
Dim http As Object
Dim htmlTable As Object
Dim htmlRow As Object
Dim htmlCell As Object
Dim url As String
Set html = CreateObject("htmlfile")
Set http = CreateObject("MSXML2.XMLHTTP")
url = "https://www.science.co.il/language/Locale-codes.php"
On Error GoTo ErrHandler
With http
.Open "GET", url, False
.send
If .Status = 200 Then html.body.innerHTML = .responseText
End With
On Error GoTo 0
Set htmlTable = html.getElementsByTagName("table")(0)
For Each htmlRow In htmlTable.getElementsByTagName("tr")
For Each htmlCell In htmlRow.Children
If htmlCell.innerText = CStr(lngCode) Then
GetLocale = htmlRow.getElementsByTagName("td")(0).innerText
Exit For
End If
Next htmlCell
Next htmlRow
If GetLocale = "" Then GetLocale = "Value Not Found From " & url
Exit Function
ErrHandler:
If Not http Is Nothing Then Set http = Nothing
GetLocale = url & " Unable To Be Accessed"
End Function
My initial code (utilising this vbforum code) assumed that Windows and Excel share a common language - likely but not bulletproof.
updated
The revised code:
- Returns the Locale ID (LCID).
- Looks up the LCID from this msft link.
- Parses the LCID using a regexp 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.
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
dim lang_code as long
lang_code = Application.LanguageSettings.LanguageID(msoLanguageIDUI)