Determine the type of a device in VBA

user_5105828 0
Viewed 686

I wanted to lock screen orientation on a tablet with an excel macro. It worked.
But when I went back to the computer, it sent me :
"Cant find DLL entry point SetDisplayAutoRotationPreferences in user32".
The code used to lock the screenb orientation is the following :

Enum ORIENTATION_PREFERENCE
    ORIENTATION_PREFERENCE_NONE = 0
    ORIENTATION_PREFERENCE_LANDSCAPE = 1
    ORIENTATION_PREFERENCE_PORTRAIT = 2
    ORIENTATION_PREFERENCE_LANDSCAPE_FLIPPED = 4
    ORIENTATION_PREFERENCE_PORTRAIT_FLIPPED = 8
End Enum

Private Declare Function SetDisplayAutoRotationPreferences Lib "user32" (ByVal ORIENTATION_PREFERENCE As Long) As Long

Sub RotateToLandscape()
    Dim lngRet As Long
    lngRet = SetDisplayAutoRotationPreference (ORIENTATION_PREFERENCE_LANDSCAPE)
End Sub

The reason it doesn't work on computers is because there's noth the SetDisplayAutoRotationPreferences function on Windows computers.

Is there any way to determine wheter the device the macro run on is a tablet or not? Or maybe to avoid the DLL entry point error?
The computer's OS is Windows 7 and it uses excel 10'.

vba excel
2 Answers

The quickest way to hack around your problem is, I suspect, to handle the error.

The preface being that with the below example that you're now going to be ignoring any potential errors that are thrown by the SetDisplayAutoRotationPreference() function. It would be entirely possible to handle more robustly to suit your needs. See for further reading: http://www.cpearson.com/excel/errorhandling.htm

Sub RotateToLandscape()
    Dim lngRet As Long

On Error Resume Next 'When error occurs skip that line
    lngRet = SetDisplayAutoRotationPreference (ORIENTATION_PREFERENCE_LANDSCAPE)
On Error GoTo 0 'Set default error handling

End Sub

Edit:

In my current enviornment the below correctly asserts that I'm using a desktop, however you may need to test on within your environment(s).

Sub test_()
strComputerType = fGetChassis()
MsgBox "This Computer is a " & strComputerType
End Sub

Function fGetChassis()
    Dim objWMIService, colChassis, objChassis, strChassisType
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colChassis = objWMIService.ExecQuery("Select * from Win32_SystemEnclosure")
    For Each objChassis In colChassis
        For Each strChassisType In objChassis.ChassisTypes
            Select Case strChassisType
                Case 8
                    fGetChassis = "Laptop" '#Portable
                Case 9
                    fGetChassis = "Laptop" '#Laptop
                Case 10
                    fGetChassis = "Laptop" '#Notebook
                Case 11
                    fGetChassis = "Laptop" '#Hand Held
                Case 12
                    fGetChassis = "Laptop" '#Docking Station
                Case 14
                    fGetChassis = "Laptop" '#Sub Notebook
                Case 18
                    fGetChassis = "Laptop" '#Expansion Chassis
                Case 21
                    fGetChassis = "Laptop" '#Peripheral Chassis
                Case Else
                    fGetChassis = "Desktop"
            End Select
        Next
    Next
End Function
user_75248500

In my search I also came across the following link: https://www.robvanderwoude.com/vbstech_inventory_laptop.php

Code below in case hyperlink dies:

If IsLaptop( "." ) Then
    WScript.Echo "Laptop"
Else
    WScript.Echo "Desktop or server"
End If


Function IsLaptop( myComputer )
' This Function checks if a computer has a battery pack.
' One can assume that a computer with a battery pack is a laptop.
'
' Argument:
' myComputer   [string] name of the computer to check,
'                       or "." for the local computer
' Return value:
' True if a battery is detected, otherwise False
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
    On Error Resume Next
    Set objWMIService = GetObject( "winmgmts://" & myComputer & "/root/cimv2" )
    Set colItems = objWMIService.ExecQuery( "Select * from Win32_Battery" )
    IsLaptop = False
    For Each objItem in colItems
        IsLaptop = True
    Next
    If Err Then Err.Clear
    On Error Goto 0
End Function
user_9598150
Related