VBA and GetRawInputDeviceList

Question

I am working in Access 2013 and try to get GetRawInputDeviceList, GetRawInputDeviceInfo, RegisterRawInputDevices and GetRawInputData equivalents for VBA with no success. I have also searched in vain for a procedure, function or module to get a list of connected HID devices to a computer to pick out a barcode scanner. This is the beginning of the third week so I am on my knees begging for assistance. Do any of you all have a module you're willing to share, a link to a website where this is dealt with? Any help is greatly appreciated.

Answer 1

Using the GetRawInputDeviceList API from VBA would be pretty tricky because of the pRawInputDeviceList parameter. Unless you're willing to jump through a ton of hoops to manage your own memory and manually handle the resulting array of RAWINPUTDEVICELIST in raw memory, you'll be better off coming at this from another direction.

Most barcode scanners I've dealt with present themselves to Windows as a keyboard. One possible solution would be to use a WMI query to enumerate attached Win32_Keyboard devices:

Private Sub ShowKeyboardInfo()
    Dim WmiServer As Object
    Dim ResultSet As Object
    Dim Keyboard As Object
    Dim Query As String

    Query = "SELECT * From Win32_Keyboard"
    Set WmiServer = GetObject("winmgmts:root/CIMV2")
    Set ResultSet = WmiServer.ExecQuery(Query)

    For Each Keyboard In ResultSet
        Debug.Print Keyboard.Name & vbTab & _
                    Keyboard.Description & vbTab & _
                    Keyboard.DeviceID & vbTab & _
                    Keyboard.Status
    Next Keyboard
End Sub

Note: If it doesn't turn up there, you can enumerate all of the USB devices by querying CIM_USBDevice: Query = "SELECT * From Win32_Keyboard"

EDIT: Per the comments, the above code won't return the handle needed to register to receive raw input events. This should get you started though - the RegisterRawInputDevices and GetRawInputData aspects are beyond the scope of what will easily go in an answer. Take a hack at it, and if you run into any problems post your code in another question.

Declarations:

Private Type RawInputDeviceList
    hDevice As Long
    dwType As Long
End Type

Private Type RidKeyboardInfo
    cbSize As Long
    dwType As Long
    dwKeyboardMode As Long
    dwNumberOfFunctionKeys As Long
    dwNumberOfIndicators As Long
    dwNumberOfKeysTotal As Long
End Type

Private Enum DeviceType
    TypeMouse = 0
    TypeKeyboard = 1
    TypeHID = 2
End Enum

Private Enum DeviceCommand
    DeviceName = &H20000007
    DeviceInfo = &H2000000B
    PreParseData = &H20000005
End Enum

Private Declare Function GetRawInputDeviceList Lib "user32" ( _
    ByVal pRawInputDeviceList As Long, _
    ByRef puiNumDevices As Long, _
    ByVal cbSize As Long) As Long

Private Declare Function GetRawInputDeviceInfo Lib "user32" Alias "GetRawInputDeviceInfoW" ( _
    ByVal hDevice As Long, _
    ByVal uiCommand As Long, _
    ByVal pData As Long, _
    ByRef pcbSize As Long) As Long

Private Declare Function GetLastError Lib "kernel32" () As Long

Sample of retrieving device names with GetRawInputDeviceInfo:

Private Sub SampleCode()
    Dim devices() As RawInputDeviceList

    devices = GetRawInputDevices
    Dim i As Long
    For i = 0 To UBound(devices)
        'Inspect the type - only looking for a keyboard.
        If devices(i).dwType = TypeKeyboard Then
            Dim buffer As String
            Dim size As Long
            'First call with a null pointer returns the string length in size.
            If GetRawInputDeviceInfo(devices(i).hDevice, DeviceName, 0&, size) = -1 Then
                Debug.Print "GetRawInputDeviceInfo error " & GetLastError()
            Else
                'Size the string buffer.
                buffer = String(size, Chr$(0))
                'The second call copies the name into the passed buffer.
                If GetRawInputDeviceInfo(devices(i).hDevice, DeviceName, StrPtr(buffer), size) = -1 Then
                    Debug.Print "GetRawInputDeviceInfo error " & GetLastError()
                Else
                    Debug.Print buffer
                End If
            End If
        End If
    Next i

End Sub

Private Function GetRawInputDevices() As RawInputDeviceList()
    Dim devs As Long
    Dim output() As RawInputDeviceList

    'First call with a null pointer returns the number of devices in devs
    If GetRawInputDeviceList(0&, devs, LenB(output(0))) = -1 Then
        Debug.Print "GetRawInputDeviceList error " & GetLastError()
    Else
        'Size the output array.
        ReDim output(devs - 1)
        'Second call actually fills the array.
        If GetRawInputDeviceList(VarPtr(output(0)), devs, LenB(output(0))) = -1 Then
            Debug.Print "GetRawInputDeviceList error " & GetLastError()
        Else
            GetRawInputDevices = output
        End If
    End If
End Function

Sorry about the side scrolling.