How can I call ActivateKeyboardLayout from 64bit Windows Vista using VBA

Question

Running VBA under XP I was able to call ActivateKeyboardLayout to switch my input language from English to another language. However, this no longer works under Vista64.

Any suggestions or workarounds?

The code that used to work under XP was similar to the following:

Private Declare Function ActivateKeyboardLayout Lib "user32" ( _
    ByVal HKL As Long, ByVal flags As Integer) As Integer
Const aklPUNJABI As Long = &H4460446
ActivateKeyboardLayout aklPUNJABI, 0

There was a suggestion to try

Public Declare Function ActivateKeyboardLayout Lib "user32" ( _
    ByVal nkl As IntPtr, ByVal Flags As uint) As Integer

When I try this I get the error message:

Variable uses an Automation type not supported in Visual Basic

Answer 1

This does not work with my own, personal modified keyboard (Microsoft Keyboard Layout Creator 1.4), where I get the error code 0^ because the keyboard's Hex value is negative !

Thus, it was necessary to use the keyboard's pointer instead of its Hex value:

Declare PtrSafe Function GetKeyboardLayoutList Lib "user32" _
(ByVal nBuff As Long, lpList As LongPtr) As Long
Declare PtrSafe Function ActivateKeyboardLayout Lib "user32" _
(ByVal HKL As LongPtr, ByVal flags As Long) As LongPtr
Const CH As LongPtr = -255850489    ' Hex: FFFFFFFFF0C00807
Const DE As LongPtr = 134678535     ' Hex: &H8070807
Const FR As LongPtr = 269225996     ' Hex: &H100C100C

Function Keyboards() As LongPtr
Dim numLayouts As Long, i As Long, layouts() As LongPtr
numLayouts = GetKeyboardLayoutList(0, ByVal 0&)
ReDim layouts(numLayouts - 1)
GetKeyboardLayoutList numLayouts, layouts(0)
Debug.Print "Loaded keyboard layouts: "
' For i = 0 To numLayouts - 1
'    Debug.Print layouts(i) & vbTab & Hex(layouts(i))
' Next
' output (direct window):
' Loaded keyboard layouts:
' 269225996   100C100C          ' French (Switzerland)
' 134678535   8070807           ' German (Switzerland)
' -255850489  FFFFFFFFF0C00807  '   "          "      (+ special characters)
End Function

Sub SetKB_CH()
Dim Dummy
Dummy = ActivateKeyboardLayout(CH, True) ' Deutsch (CH) - ergänzt
End Sub

This works perfectly on my Win11Pro×64(24H2) system. To get the currently active keyboard :

Declare PtrSafe Function GetKeyboardLayout Lib "user32" _
(ByVal dwLayout As Long) As LongPtr
Function Keyboard() As LongPtr
Keyboard = GetKeyboardLayout(ByVal 0&)
End Function

NOTE: it is absolutely necessary for me to replace my own keyboard with a standard one when working on MS Access: due to the obvious serious, deep bug in v.24H2, the keyboard buffer is affected by mouse and form actions (when typing a in the first textbox of a new record in a form, I get Гa , when typing v I get ↕ , etc. ! — SendKeys "{BACKSPACE}" before a or v avoids the bug, proving that there is garbage in the keyboard buffer though the keyboard wasn't touched at all…); the same bug appears sometimes in Firefox, too and since I use a previous version of Office 2019, it is not related to the latest, buggy Office version (in Access, MouseWheel returns always count 0)

Answer 2

In 64-bit editions of Office apps, VBA is indeed 64-bit. See Office 2010 documentation for details of the changes. For the example given in Stephen Martin's answer, you will need to change the code as follows to add the PtrSafe attribute and fixup the parameters that have a HKL type in the Win32 API:

Private Declare PtrSafe Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As LongPtr, _
    ByVal flags As Long) As LongPtr

Const aklPUNJABI As LongPtr = &H4460446
Dim oldLayout as LongPtr
oldLayout = ActivateKeyboardLayout(aklPUNJABI, 0)
If oldLayout = 0 Then
   'Oops an error'
Else
   'Save old layout for later restore?'
End If

and

Private Declare PtrSafe Function GetKeyboardLayoutList Lib "user32" (ByVal size As Long, _
    ByRef layouts As LongPtr) As Long

Dim numLayouts As Long
Dim i As Long
Dim layouts() As LongPtr

numLayouts = GetKeyboardLayoutList(0, ByVal 0&)
ReDim layouts(numLayouts - 1)
GetKeyboardLayoutList numLayouts, layouts(0)

Dim msg As String
msg = "Loaded keyboard layouts: " & vbCrLf & vbCrLf

For i = 0 To numLayouts - 1
   msg = msg & Hex(layouts(i)) & vbCrLf
Next

MsgBox msg

Answer 3

The thing that everyone seems to overlook here is that you are working in VBA, not in .NET. IntPtr is a .NET type which represents an integer which is native to the platform. On a 32-bit platform it is 32 bits, on a 64 bit platform, it is 64 bits.

Given that an HKL is a typedef for a handle, which is a typedef for PVOID which is a typedef for VOID *, it's exactly what you need, if you were using .NET.

VBA doesn't have anything for 64-bit numbers, so you have to take a different approach.

On a 64-bit machine, you will have to do something like this:

Public Type HKL64
    High As Long
    Low As Long
End Type

Private Declare Function ActivateKeyboardLayout Lib "user32" ( _
    Byval HklHigh As Long, Byval HklLow As Long, _
    ByVal flags As Integer) As HKL64

This should allow you to pass a 64 bit value on the stack to the API function (across two variables). However, if you are going to use this code on 64 bit and 32 bit machines, you are going to have to make two declarations of the API and then determine which one to call.

Also, any other code in VBA that calls APIs that deal with pointers or handles will have to be changed appropriately to handle 64 bit input (not 32).

On a side note, the original declaration of ActivateKeyboardLayout is wrong, as it had a return type of Integer, which is a 16-bit value, while the API returns a type of HKL, which is 32 or 64 bits, depending on the platform.

Answer 4

Your declaration for the ActivateKeyboardLayout is actually incorrect. For 32-bit systems your code should be something like this:

Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, _
    ByVal flags As Long) As Long

Const aklPUNJABI As Long = &H4460446
Dim oldLayout as Long
oldLayout = ActivateKeyboardLayout(aklPUNJABI, 0)
If oldLayout = 0 Then
   'Oops an error'
Else
   'Save old layout for later restore?'
End If

The 64-bitness of the operating system is a bit of a red herring in this case. Since you are running a VBA app it must be running as a 32-bit app regardless of OS. I suspect your problem may be that on your Vista system the Punjabi keyboard layout that you want is not loaded. ActivateKeyboardLayout will only work to activate a keyboard layout that is already loaded. For some reason the designers of this API felt that failure due to the keyboard layout not existing was not an error so the LastDllError is not set. You may want to look into using LoadKeyboardLayout for this type of situation.

EDIT: To double check that the keyboard layout you are trying to get is actually loaded you can use this:

Private Declare Function GetKeyboardLayoutList Lib "user32" (ByVal size As Long, _
    ByRef layouts As Long) As Long

Dim numLayouts As Long
Dim i As Long
Dim layouts() As Long

numLayouts = GetKeyboardLayoutList(0, ByVal 0&)
ReDim layouts(numLayouts - 1)
GetKeyboardLayoutList numLayouts, layouts(0)

Dim msg As String
msg = "Loaded keyboard layouts: " & vbCrLf & vbCrLf

For i = 0 To numLayouts - 1
   msg = msg & Hex(layouts(i)) & vbCrLf
Next

MsgBox msg

Answer 5

For 64-bit portability you may need to use IntPtr. Can you give this a shot?

Public Declare Function ActivateKeyboardLayout Lib "user32" (ByVal nkl As IntPtr, ByVal Flags As uint) As Integer

Answer 6

Did you try a .Net line (as in VB.Net script or those snippets) like:

InputLanguage.CurrentInputLanguage = 
    InputLanguage.FromCulture(New System.Globalization.CultureInfo("ar-EG"))

InputLanguage should be supported for Vista64 with a .Net3.5

VB.Net code:

Public Sub ChangeInputLanguage(ByVal InputLang As InputLanguage)
   If InputLanguage.InstalledInputLanguages.IndexOf(InputLang) = -1 Then
        Throw New ArgumentOutOfRangeException()
   End If
    InputLanguage.CurrentInputLanguage = InputLang
End Sub

Answer 7

This is just a blind guess, but have you tried running your app as elevated administrator to see if it makes a difference? What's the error code / value of GetLastError?