Get the language for non unicode programs with VBA

[nd0911]

Hello,

Is it possible to get with VBA code the language (or a some kind of representative number of that language) that are configure for the "non unicode programs" in the control panel>Region>Administrative ?

 

[yky]

Would you elaborate on your question, maybe with some examples?

 

[nd0911]

I need to get the current language for non-unicode programs (number 2 in the image link), with VBA...

https://www.digitalcitizen.life/sites/default/files/gdrive/non_unicode_language/language_unicode_5.png

 

[nd0911]

Anyone ?

 

[GWteB]

Try this ...

Public Sub GetLocale()

    Const cRegPath      As String = "HKEY_CURRENT_USER\Control Panel\International\"
  
    Dim lLocale         As Long
    Dim lLocaleDec      As Long
    Dim sRegKey         As String
    Dim sLocaleName     As String
    Dim sCountry        As String
    Dim sLanguage       As String
  
    sRegKey = cRegPath & "Locale"
    If RegKeyExists(sRegKey) = True Then lLocale = CLng(RegKeyRead(sRegKey)): lLocaleDec = "&H" & lLocale
  
    sRegKey = cRegPath & "LocaleName"
    If RegKeyExists(sRegKey) = True Then sLocaleName = RegKeyRead(sRegKey)
  
    sRegKey = cRegPath & "sCountry"
    If RegKeyExists(sRegKey) = True Then sCountry = RegKeyRead(sRegKey)
  
    sRegKey = cRegPath & "sLanguage"
    If RegKeyExists(sRegKey) = True Then sLanguage = RegKeyRead(sRegKey)
  
    MsgBox "Language:" & vbTab & sLanguage & vbCrLf & _
           "Country:" & vbTab & vbTab & sCountry & vbCrLf & _
           "Locale:" & vbTab & vbTab & lLocale & " Hex (" & lLocaleDec & ")" & vbCrLf & _
           "LocaleName:" & vbTab & sLocaleName, vbInformation
End Sub

Function RegKeyExists(ByRef RegKey As String) As Boolean
    Dim oWinScr As Object
    RegKeyExists = True
    Set oWinScr = CreateObject("WScript.Shell")
    On Error GoTo PITTY
    oWinScr.RegRead RegKey
    Set oWinScr = Nothing
    Exit Function
PITTY:
    MsgBox Err.nr & vbCrLf & _
            Err.Description & vbCrLf & _
            Err.Source
    RegKeyExists = False
    Err.Clear
    Resume Next
End Function

Public Function RegKeyRead(ByRef RegKey As String) As String
    Dim oWinScr As Object
    On Error Resume Next
    Set oWinScr = CreateObject("WScript.Shell")
    RegKeyRead = oWinScr.RegRead(RegKey)
    Set oWinScr = Nothing
End Function

 

[nd0911]

Unfortunately it doesn't work because even if I switch the language (in the non-unicode programs field in the control panel) the code result returns the same value as before...

any idea ?

 

[GWteB]

After you've changed some language settings, did you restart your computer?

 

[nd0911]

Yes.

 

[GWteB]

I also made some changes within control panel > non-unicode programs, and performed a reboot. The locale isn't affected by that indeed. I'm afraid I can't help you further.

 

[rlv01]

Can you use the registry code page setting?

Sub GetCodepage()
    Dim CodePage As String

    On Error Resume Next
    With CreateObject("WScript.Shell")                'get the system CodePage
        CodePage = .RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\CodePage\OEMCP")
    End With
    On Error GoTo 0

    Select Case CodePage
    Case "437"                                        'United States
        MsgBox "Codepage for United States", vbInformation, "Codepage 437"
    Case "708"                                        'Arabic (ASMO 708)
        MsgBox "Codepage for Arabic (ASMO 708)", vbInformation, "Codepage 708"
    Case "720"                                        'Arabic (Transparent ASMO)
        MsgBox "Codepage for Arabic (Transparent ASMO)", vbInformation, "Codepage 720"
    Case "737"                                        'Greek (formerly 437G)
        MsgBox "Codepage for Greek (formerly 437G)", vbInformation, "Codepage 737"
    Case "775"                                        'Baltic
        MsgBox "Codepage for Baltic", vbInformation, "Codepage 775"
    Case "850"                                        'Multilingual (Latin I)
        MsgBox "Codepage for Multilingual (Latin I)", vbInformation, "Codepage 850"
    Case "852"                                        'Slavic (Latin II)
        MsgBox "Codepage for Slavic (Latin II)", vbInformation, "Codepage 852"
    Case "855"                                        'Cyrillic
        MsgBox "Codepage for Cyrillic", vbInformation, "Codepage 855"
    Case "857"                                        'Turkish
        MsgBox "Codepage for Turkish", vbInformation, "Codepage 857"
    Case "860"                                        'Portuguese
        MsgBox "Codepage for Portuguese", vbInformation, "Codepage 860"
    Case "861"                                        'Icelandic
        MsgBox "Codepage for Icelandic", vbInformation, "Codepage 861"
    Case "862"                                        'Hebrew
        MsgBox "Codepage for Hebrew", vbInformation, "Codepage 862"
    Case "863"                                        'Canadian-French
        MsgBox "Codepage for Canadian-French", vbInformation, "Codepage 863"
    Case "864"                                        'Arabic
        MsgBox "Codepage for Arabic", vbInformation, "Codepage 864"
    Case "865"                                        'Nordic
        MsgBox "Codepage for Nordic", vbInformation, "Codepage 865"
    Case "866"                                        'Russian
        MsgBox "Codepage for Russian", vbInformation, "Codepage 866"
    Case "869"                                        'Modern Greek
        MsgBox "Codepage for Modern Greek", vbInformation, "Codepage 869"
    Case "874"                                        'Thai
        MsgBox "Codepage for Thai", vbInformation, "Codepage 874"
    Case "932"                                        'ShiftJIS - Japan
        MsgBox "Codepage for ShiftJIS - Japan", vbInformation, "Codepage 932"
    Case "936"                                        'GBK - Chinese (PRC, Singapore)
        MsgBox "Codepage for GBK - Chinese (PRC, Singapore)", vbInformation, "Codepage 936"
    Case "949"                                        'Korean Unified Hangul
        MsgBox "Codepage for Korean Unified Hangul", vbInformation, "Codepage 949"
    Case "950"                                        'Big5 Extended - Chinese (Taiwan, Hong Kong SAR)
        MsgBox "Codepage for Big5 Extended - Chinese (Taiwan, Hong Kong SAR) ", vbInformation, "Codepage 950"
    Case Else
        MsgBox "Unkown Codepage: " & CodePage, vbInformation
    End Select
End Sub