Jaafar Tribak
Well-known Member
- Joined
- Dec 5, 2002
- Messages
- 9,621
- Office Version
- 2016
- Platform
- Windows
Hi all,
I have been working on this little project for the last couple of days and thought I would post it here for the benefit of others.
In some situations, we find ourselves in need to retrieve info about automation elements for a specific window. The easiest way is to use the UIAutomationClient library and call the ElementFromHandle Method but, in order to use this library, we first need to set a vbaproject reference to it @ design time. I hate having to reference external libraries in my workbooks, plus the fact that the UIAutomationClient is somewhat overwhelmingly complicated made me think of trying to write this easier class for the required task.
Obviously, we could always simply use the IAccessibility Interface for walking the accessibility tree but, unlike the Automation library, it lacks many useful and interesting Properties and Methods. The class I am posting here uses low level com calls (no external references required) and indirectly borrows Properties and Methods from both interfaces: IAccessibility and IUIAutomation.
I have tested the class in both excel x32 and x64. So far, it works as expected. I just hope it is robust enough.
File Download:
AccessibilityEx.xlsm
1- Class code: (C_AccEx)
2- Interface code;
I have been working on this little project for the last couple of days and thought I would post it here for the benefit of others.
In some situations, we find ourselves in need to retrieve info about automation elements for a specific window. The easiest way is to use the UIAutomationClient library and call the ElementFromHandle Method but, in order to use this library, we first need to set a vbaproject reference to it @ design time. I hate having to reference external libraries in my workbooks, plus the fact that the UIAutomationClient is somewhat overwhelmingly complicated made me think of trying to write this easier class for the required task.
Obviously, we could always simply use the IAccessibility Interface for walking the accessibility tree but, unlike the Automation library, it lacks many useful and interesting Properties and Methods. The class I am posting here uses low level com calls (no external references required) and indirectly borrows Properties and Methods from both interfaces: IAccessibility and IUIAutomation.
I have tested the class in both excel x32 and x64. So far, it works as expected. I just hope it is robust enough.
File Download:
AccessibilityEx.xlsm
1- Class code: (C_AccEx)
VBA Code:
Option Explicit
Implements IAccElement
#If Win64 Then
Private Const NULL_PTR = 0^
Private Const PTR_LEN = 8&
#Else
Private Const NULL_PTR = 0&
Private Const PTR_LEN = 4&
#End If
Public Enum TreeScope
TreeScope_None = 0&
TreeScope_Element = 1&
TreeScope_Children = 2&
TreeScope_Descendants = 4&
TreeScope_Subtree = ((TreeScope_Element + TreeScope_Children) + TreeScope_Descendants)
End Enum
#If VBA7 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
Private Declare PtrSafe Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)
Private Declare PtrSafe Function StringFromGUID2 Lib "ole32" (ByRef rguid As GUID, ByVal lpsz As LongPtr, ByVal cchMax As Long) As Long
Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
Private Declare PtrSafe Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As LongPtr, ByRef cGUID As GUID) As Long
Private Declare PtrSafe Function CoCreateInstance Lib "ole32" (ByRef rclsid As GUID, ByVal pUnkOuter As LongPtr, ByVal dwClsContext As Long, ByRef riid As GUID, ByRef ppv As LongPtr) As Long
Private Declare PtrSafe Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
#Else
Private Enum LongPtr
[_]
End Enum
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As LongPtr) As Long
Private Declare Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)
Private Declare Function StringFromGUID2 Lib "ole32" (ByRef rguid As GUID, ByVal lpsz As LongPtr, ByVal cchMax As Long) As Long
Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, ByVal lpiid As LongPtr) As LongPtr
Private Declare Function CLSIDFromString Lib "ole32" (ByVal OleStringCLSID As LongPtr, ByRef cGUID As GUID) As Long
Private Declare Function CoCreateInstance Lib "ole32" (ByRef rclsid As GUID, ByVal pUnkOuter As LongPtr, ByVal dwClsContext As Long, ByRef riid As GUID, ByRef ppv As LongPtr) As Long
Private Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
#End If
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type RECT_PTR
Left As LongPtr
Top As LongPtr
Right As LongPtr
Bottom As LongPtr
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0& To 7&) As Byte
End Type
Private oElements As Collection
Private oElement As C_AccEx
Private pAutomation As LongPtr
Private pPattern As LongPtr
Private pElement As LongPtr
Private pElementArray As LongPtr
Private pTrueCond As LongPtr
Private pLegacyName As LongPtr
Private pAccKey As LongPtr
Private pItemType As LongPtr
Private pLocalControlType As LongPtr
Private pDefaultAction As LongPtr
Private pKeyboardShortcut As LongPtr
Private pClassName As LongPtr
Private pValue As LongPtr
Private pLegacyDescription As LongPtr
Private pLegacyHelp As LongPtr
Private lHwnd As LongPtr
Private lOrientation As Long
Private lItemStatus As Long
Private lProcID As Long
Private lRole As Long
Private lState As Long
Private lControlType As Long
Private lProcessID As Long
Private sName As String
Private sDescription As String
Private sHelpText As String
Private sValue As String
Private sDefaultAction As String
Private sKeyboardShortcut As String
Private sAcceleratorKey As String
Private sClassName As String
Private sItemType As String
Private sLocalControlType As String
Private bHasKeyboardFocus As Boolean
Private bIsEnabled As Boolean
Private bOffScreen As Boolean
Private bIsPassword As Boolean
Private Sub Class_Initialize()
Set oElements = New Collection
End Sub
' __________________________________________ Public Members __________________________________________________
Sub GetAccessibleChildrenFromHwnd(ByVal hwnd As LongPtr, Optional ByVal Scope As TreeScope = TreeScope_Subtree)
If IsWindow(hwnd) = 0& Then
MsgBox "Invalid Window Handle !": Exit Sub
End If
Call FindElements(hwnd, Scope)
End Sub
Function ElementsCount() As Long
ElementsCount = oElements.Count
End Function
Property Get Items() As Collection
Set Items = oElements
End Property
Property Get Name() As String
Name = sName
End Property
Property Let Name(ByVal vNewValue As String)
sName = vNewValue
End Property
Property Get Role() As Long
Role = lRole
End Property
Property Let Role(ByVal vNewValue As Long)
lRole = vNewValue
End Property
Property Get Description() As String
Description = sDescription
End Property
Property Let Description(ByVal vNewValue As String)
sDescription = vNewValue
End Property
Property Get HelpText() As String
HelpText = sHelpText
End Property
Property Let HelpText(ByVal vNewValue As String)
sHelpText = vNewValue
End Property
Property Get State() As Long
State = lState
End Property
Property Let State(ByVal vNewValue As Long)
lState = vNewValue
End Property
Property Get Value() As String
Value = sValue
End Property
Property Let Value(ByVal vNewValue As String)
sValue = vNewValue
End Property
Property Get DefaultAction() As String
DefaultAction = sDefaultAction
End Property
Property Let DefaultAction(ByVal vNewValue As String)
sDefaultAction = vNewValue
End Property
Property Get KeyboardShortcut() As String
KeyboardShortcut = sKeyboardShortcut
End Property
Property Let KeyboardShortcut(ByVal vNewValue As String)
sKeyboardShortcut = vNewValue
End Property
Property Get AcceleratorKey() As String
AcceleratorKey = sAcceleratorKey
End Property
Property Let AcceleratorKey(ByVal vNewValue As String)
sAcceleratorKey = vNewValue
End Property
Property Get ControlType() As Long
ControlType = lControlType
End Property
Property Let ControlType(ByVal vNewValue As Long)
lControlType = vNewValue
End Property
Property Get HasKeyboardFocus() As Boolean
HasKeyboardFocus = bHasKeyboardFocus
End Property
Property Let HasKeyboardFocus(ByVal vNewValue As Boolean)
bHasKeyboardFocus = vNewValue
End Property
Property Get IsEnabled() As Boolean
IsEnabled = bIsEnabled
End Property
Property Let IsEnabled(ByVal vNewValue As Boolean)
bIsEnabled = vNewValue
End Property
Property Get ClassName() As String
ClassName = sClassName
End Property
Property Let ClassName(ByVal vNewValue As String)
sClassName = vNewValue
End Property
Property Get IsOffScreen() As Boolean
IsOffScreen = bOffScreen
End Property
Property Let IsOffScreen(ByVal vNewValue As Boolean)
bOffScreen = vNewValue
End Property
Property Get ItemType() As String
ItemType = sItemType
End Property
Property Let ItemType(ByVal vNewValue As String)
sItemType = vNewValue
End Property
Property Get ProcessID() As Long
ProcessID = lProcessID
End Property
Property Let ProcessID(ByVal vNewValue As Long)
lProcessID = vNewValue
End Property
Property Get LocalControlType() As String
LocalControlType = sLocalControlType
End Property
Property Let LocalControlType(ByVal vNewValue As String)
sLocalControlType = vNewValue
End Property
Property Get Orientation() As Long
Orientation = lOrientation
End Property
Property Let Orientation(ByVal vNewValue As Long)
lOrientation = vNewValue
End Property
Property Get ItemStatus() As Long
ItemStatus = lItemStatus
End Property
Property Let ItemStatus(ByVal vNewValue As Long)
lItemStatus = vNewValue
End Property
Property Get IsPassword() As Boolean
IsPassword = bIsPassword
End Property
Property Let IsPassword(ByVal vNewValue As Boolean)
bIsPassword = vNewValue
End Property
Property Get WindowHandle() As LongPtr
WindowHandle = lHwnd
End Property
Property Let WindowHandle(ByVal vNewValue As LongPtr)
lHwnd = vNewValue
End Property
Property Get pIAutomation() As LongPtr
pIAutomation = pAutomation
End Property
Property Let pIAutomation(ByVal vNewValue As LongPtr)
pAutomation = vNewValue
End Property
Property Get pIPattern() As LongPtr
pIPattern = pPattern
End Property
Property Let pIPattern(ByVal vNewValue As LongPtr)
pPattern = vNewValue
End Property
Property Get pITrueCond() As LongPtr
pITrueCond = pTrueCond
End Property
Property Let pITrueCond(ByVal vNewValue As LongPtr)
pTrueCond = vNewValue
End Property
Property Get pIElementArray() As LongPtr
pIElementArray = pElementArray
End Property
Property Let pIElementArray(ByVal vNewValue As LongPtr)
pElementArray = vNewValue
End Property
Property Get pIElement() As LongPtr
pIElement = pElement
End Property
Property Let pIElement(ByVal vNewValue As LongPtr)
pElement = vNewValue
End Property
Sub GetClickablePoint(ByRef X As Long, ByRef Y As Long)
Call ClickablePoint(X, Y)
End Sub
Sub GetScreenBoundingRectangle(X As Long, Y As Long, nWidth As Long, nHeight As Long)
Call ScreenBoundingRectangle(X, Y, nWidth, nHeight)
End Sub
Sub SelectMe()
Call Select_Item
End Sub
Sub DoDefaultAction()
Call DoDefaultAct
End Sub
' _____________________________________________ Interface Imp Routines ___________________________________________
Private Property Get IAccElement_pIAutomation() As LongPtr
IAccElement_pIAutomation = pAutomation
End Property
Private Property Get IAccElement_pITrueCond() As LongPtr
IAccElement_pITrueCond = pTrueCond
End Property
Private Property Get IAccElement_pIElementArray() As LongPtr
IAccElement_pIElementArray = pElementArray
End Property
Private Property Get IAccElement_pIElement() As LongPtr
IAccElement_pIElement = pElement
End Property
Private Property Get IAccElement_pIPattern() As LongPtr
IAccElement_pIPattern = pPattern
End Property
Private Property Get IAccElement_DefaultAction() As String
IAccElement_DefaultAction = sDefaultAction
End Property
Private Property Get IAccElement_Description() As String
IAccElement_Description = sDescription
End Property
Private Property Get IAccElement_AcceleratorKey() As String
IAccElement_AcceleratorKey = sAcceleratorKey
End Property
Private Property Get IAccElement_HelpText() As String
IAccElement_HelpText = sHelpText
End Property
Private Property Get IAccElement_KeyboardShortcut() As String
IAccElement_KeyboardShortcut = sKeyboardShortcut
End Property
Private Property Get IAccElement_Name() As String
IAccElement_Name = sName
End Property
Private Property Get IAccElement_Role() As Long
IAccElement_Role = lRole
End Property
Private Property Get IAccElement_State() As Long
IAccElement_State = lState
End Property
Private Property Get IAccElement_Value() As String
IAccElement_Value = sValue
End Property
Private Property Get IAccElement_ClassName() As String
IAccElement_ClassName = sClassName
End Property
Private Property Get IAccElement_ControlType() As Long
IAccElement_ControlType = lControlType
End Property
Private Property Get IAccElement_HasKeyboardFocus() As Boolean
IAccElement_HasKeyboardFocus = bHasKeyboardFocus
End Property
Private Property Get IAccElement_IsEnabled() As Boolean
IAccElement_IsEnabled = bIsEnabled
End Property
Private Property Get IAccElement_IsOffScreen() As Boolean
IAccElement_IsOffScreen = bOffScreen
End Property
Private Property Get IAccElement_IsPassword() As Boolean
IAccElement_IsPassword = bIsPassword
End Property
Private Property Get IAccElement_ItemStatus() As Long
IAccElement_ItemStatus = lItemStatus
End Property
Private Property Get IAccElement_ItemType() As String
IAccElement_ItemType = sItemType
End Property
Private Property Get IAccElement_LocalControlType() As String
IAccElement_LocalControlType = sLocalControlType
End Property
Private Property Get IAccElement_Orientation() As String
IAccElement_Orientation = lOrientation
End Property
Private Property Get IAccElement_ProcessID() As Long
IAccElement_ProcessID = lProcessID
End Property
Private Property Get IAccElement_WindowHandle() As LongPtr
IAccElement_WindowHandle = lHwnd
End Property
Private Sub IAccElement_SelectMe()
Call Select_Item
End Sub
Private Sub IAccElement_DoDefaultAction()
Call DoDefaultAct
End Sub
Private Sub IAccElement_GetClickablePoint(ByRef X As Long, ByRef Y As Long)
Call ClickablePoint(X, Y)
End Sub
Private Sub IAccElement_GetScreenBoundingRectangle(ByRef X As Long, ByRef Y As Long, ByRef nWidth As Long, ByRef nHeight As Long)
Call ScreenBoundingRectangle(X, Y, nWidth, nHeight)
End Sub
' ___________________________________________ Private Routines __________________________________________________
Private Function GetAutomationPtr() As LongPtr
Const IID_CUIAUTOMATION = "{FF48DBA4-60EF-4201-AA87-54103EEF594E}"
Const IID_IUIAUTOMATION = "{30CBE57D-D9D0-452A-AB13-7AC5AC4825EE}"
Const CLSCTX_INPROC_SERVER = &H1, CC_STDCALL = 4&, S_OK = 0&
Dim iidCuiAuto As GUID, iidIuiAuto As GUID, lRet As Long
lRet = CLSIDFromString(StrPtr(IID_CUIAUTOMATION), iidCuiAuto)
Call DispGUID(iidCuiAuto)
lRet = CLSIDFromString(StrPtr(IID_IUIAUTOMATION), iidIuiAuto)
Call DispGUID(iidIuiAuto)
lRet = CoCreateInstance(iidCuiAuto, NULL_PTR, CLSCTX_INPROC_SERVER, iidIuiAuto, pAutomation)
If lRet = S_OK Then GetAutomationPtr = pAutomation
End Function
Private Sub FindElements(ByVal hwnd As LongPtr, Optional ByVal Scope As TreeScope = TreeScope_Subtree)
Const CC_STDCALL = 4&, TreeScope_Descendants = 4&, UIA_LegacyIAccessiblePatternId = 10018&
Const IID_IUIAutomationLegacyIAccessiblePattern = "{828055ad-355b-4435-86d5-3b51c14a9b1b}"
Dim lIndex As Long, lElementsCount As Long
Dim lRet As Long, vTblOffset As Long, vFuncOrdinal As Long
Dim iidCuiAuto As GUID
pAutomation = GetAutomationPtr
If pAutomation = NULL_PTR Then MsgBox "Automation failed.": Exit Sub
vFuncOrdinal = 6& ' IUIAutomation::ElementFromHandle
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pAutomation, vTblOffset, vbLong, CC_STDCALL, hwnd, VarPtr(pElement))
vFuncOrdinal = 21& ' IUIAutomation::CreateTrueCondition
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pAutomation, vTblOffset, vbLong, CC_STDCALL, VarPtr(pTrueCond))
vFuncOrdinal = 6& ' IUIAutomationElement::FindAll
vTblOffset = vFuncOrdinal * PTR_LEN ' IUIAutomationElement::FindAll
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, Scope, pTrueCond, VarPtr(pElementArray))
vFuncOrdinal = 3& ' IUIAutomationElementArray :get_Length
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElementArray, vTblOffset, vbLong, CC_STDCALL, VarPtr(lElementsCount))
If lElementsCount = 0& Then
MsgBox "No Accessible descendants were found.": Exit Sub
End If
For lIndex = 0& To lElementsCount - 1&
vFuncOrdinal = 4& ' IUIAutomationElementArray :GetElement
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElementArray, vTblOffset, vbLong, CC_STDCALL, lIndex, VarPtr(pElement))
lRet = CLSIDFromString(StrPtr(IID_IUIAutomationLegacyIAccessiblePattern), iidCuiAuto)
Call DispGUID(iidCuiAuto)
vFuncOrdinal = 14& 'IID_IUIAutomationElement::GetCurrentPatternAs
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, UIA_LegacyIAccessiblePatternId, VarPtr(iidCuiAuto), VarPtr(pPattern))
If pPattern <> NULL_PTR Then
'Store Interfaces Ptrs in each new class instance.
Set oElement = New C_AccEx
With oElement
.pIAutomation = pAutomation
.pITrueCond = pTrueCond
.pIElementArray = pElementArray
.pIElement = pElement
.pIPattern = pPattern
End With
'Retrieve descendants properties.
vFuncOrdinal = 7& 'IID_IUIAutomationLegacyIAccessiblePattern::get_CurrentName
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pPattern, vTblOffset, vbLong, CC_STDCALL, VarPtr(pLegacyName))
oElement.Name = GetStrFromPtrW(pLegacyName)
vFuncOrdinal = 10& 'IID_IUIAutomationLegacyIAccessiblePattern::get_CurrentRole
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pPattern, vTblOffset, vbLong, CC_STDCALL, VarPtr(lRole))
oElement.Role = lRole
vFuncOrdinal = 9& 'IID_IUIAutomationLegacyIAccessiblePattern::get_CurrentDescription
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pPattern, vTblOffset, vbLong, CC_STDCALL, VarPtr(pLegacyDescription))
oElement.Description = GetStrFromPtrW(pLegacyDescription)
vFuncOrdinal = 12& 'IID_IUIAutomationLegacyIAccessiblePattern::get_CurrentHelp
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pPattern, vTblOffset, vbLong, CC_STDCALL, VarPtr(pLegacyHelp))
oElement.HelpText = GetStrFromPtrW(pLegacyHelp)
vFuncOrdinal = 11& 'IID_IUIAutomationLegacyIAccessiblePattern::get_CurrentState
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pPattern, vTblOffset, vbLong, CC_STDCALL, VarPtr(lState))
oElement.State = lState
vFuncOrdinal = 8& 'IID_IUIAutomationLegacyIAccessiblePattern::get_CurrentValue
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pPattern, vTblOffset, vbLong, CC_STDCALL, VarPtr(pValue))
oElement.Value = GetStrFromPtrW(pValue)
vFuncOrdinal = 15& 'IID_IUIAutomationLegacyIAccessiblePattern::get_CurrentDefaultAction
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pPattern, vTblOffset, vbLong, CC_STDCALL, VarPtr(pDefaultAction))
oElement.DefaultAction = GetStrFromPtrW(pDefaultAction)
vFuncOrdinal = 13& 'IID_IUIAutomationLegacyIAccessiblePattern::get_CurrentKeyboardShortcut
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pPattern, vTblOffset, vbLong, CC_STDCALL, VarPtr(pKeyboardShortcut))
oElement.KeyboardShortcut = GetStrFromPtrW(pKeyboardShortcut)
vFuncOrdinal = 21& 'IUIAutomationElement::get_CurrentControlType
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(lControlType))
oElement.ControlType = lControlType
vFuncOrdinal = 24& 'IUIAutomationElement::get_CurrentAcceleratorKey
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(pAccKey))
oElement.AcceleratorKey = GetStrFromPtrW(pAccKey)
vFuncOrdinal = 26& 'IUIAutomationElement::get_CurrentHasKeyboardFocus
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(bHasKeyboardFocus))
oElement.HasKeyboardFocus = bHasKeyboardFocus
vFuncOrdinal = 28& 'IUIAutomationElement::get_CurrentIsEnabled
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(bIsEnabled))
oElement.IsEnabled = bIsEnabled
vFuncOrdinal = 30& 'IUIAutomationElement::get_CurrentClassName
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(pClassName))
oElement.ClassName = GetStrFromPtrW(pClassName)
vFuncOrdinal = 38& 'IUIAutomationElement::get_CurrentIsOffscreen
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(bOffScreen))
oElement.KeyboardShortcut = bOffScreen
vFuncOrdinal = 37& 'IUIAutomationElement::get_CurrentItemType
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(pItemType))
oElement.ItemType = GetStrFromPtrW(pItemType)
vFuncOrdinal = 20& 'IUIAutomationElement::get_CurrentProcessId
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(lProcID))
oElement.ProcessID = lProcID
vFuncOrdinal = 22& 'IUIAutomationElement::get_CurrentLocalizedControlType
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(pLocalControlType))
oElement.LocalControlType = GetStrFromPtrW(pLocalControlType)
vFuncOrdinal = 39& 'IUIAutomationElement::get_CurrentOrientation
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(lOrientation))
oElement.Orientation = lOrientation
vFuncOrdinal = 43& 'IUIAutomationElement::get_CurrentItemStatus
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(lItemStatus))
oElement.ItemStatus = lOrientation
vFuncOrdinal = 35& 'IUIAutomationElement::get_CurrentIsPassword
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(bIsPassword))
oElement.IsPassword = bIsPassword
vFuncOrdinal = 36& 'IUIAutomationElement::get_CurrentNativeWindowHandle
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(pElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(lHwnd))
oElement.WindowHandle = lHwnd
'Release IUIAutomationElement Interface.
vFuncOrdinal = 2& 'IUIAutomationElement::Release
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(Me.pIElement, vTblOffset, vbEmpty, CC_STDCALL)
'Add all found elements to collection.
oElements.Add oElement
End If
Next lIndex
'Release other Automation Interfaces.
If Me.pIAutomation Then
lRet = vtblCall(Me.pIElementArray, vTblOffset, vbEmpty, CC_STDCALL) 'IUIAutomationElementArray ::Release
lRet = vtblCall(Me.pITrueCond, vTblOffset, vbEmpty, CC_STDCALL) 'IUIAutomationCondition ::Release
lRet = vtblCall(Me.pIAutomation, vTblOffset, vbEmpty, CC_STDCALL) 'IUIAutomation::Release
End If
End Sub
Private Sub ClickablePoint(ByRef X As Long, ByRef Y As Long)
Const CC_STDCALL = 4&
Dim Pt1 As Currency, Pt2 As POINTAPI
Dim lClickable As Long
Dim lRet As Long, vTblOffset As Long, vFuncOrdinal As Long
vFuncOrdinal = 84& 'IUIAutomationElement::GetClickablePoint
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(Me.pIElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(Pt1), VarPtr(lClickable))
Call CopyMemory(Pt2, Pt1, LenB(Pt2))
X = Pt2.X: Y = Pt2.Y
End Sub
Private Sub ScreenBoundingRectangle(X As Long, Y As Long, nWidth As Long, nHeight As Long)
Const CC_STDCALL = 4&
Dim lRet As Long, vTblOffset As Long, vFuncOrdinal As Long
vFuncOrdinal = 43& 'IUIAutomationElement::get_CurrentBoundingRectangle
vTblOffset = vFuncOrdinal * PTR_LEN
#If Win64 Then
Dim R As RECT_PTR
Dim Pt1 As POINTAPI, Pt2 As POINTAPI
lRet = vtblCall(Me.pIElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(R))
Call CopyMemory(Pt1, ByVal VarPtr(R), PTR_LEN)
Call CopyMemory(Pt2, ByVal VarPtr(R) + PTR_LEN, PTR_LEN)
X = Pt1.X: Y = Pt1.Y
nWidth = Pt2.X - X: nHeight = Pt2.Y - Y
#Else
Dim R As RECT
lRet = vtblCall(Me.pIElement, vTblOffset, vbLong, CC_STDCALL, VarPtr(R))
With R
X = .Left: Y = .Top
nWidth = .Right - .Left: nHeight = .Bottom - .Top
End With
#End If
End Sub
Private Sub DoDefaultAct()
Const CC_STDCALL = 4&
Dim lRet As Long, vTblOffset As Long, vFuncOrdinal As Long
vFuncOrdinal = 4& 'IID_IUIAutomationLegacyIAccessiblePattern::DoDefaultAction
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(Me.pIPattern, vTblOffset, vbEmpty, CC_STDCALL)
End Sub
Private Sub Select_Item()
Const CC_STDCALL = 4&, SELFLAG_TAKEFOCUS = 1&, SELFLAG_TAKESELECTION = 2&
Dim lRet As Long, vTblOffset As Long, vFuncOrdinal As Long, selFlag As Long
selFlag = SELFLAG_TAKEFOCUS + SELFLAG_TAKESELECTION
vFuncOrdinal = 3& 'IUIAutomationLegacyIAccessiblePattern::Select
vTblOffset = vFuncOrdinal * PTR_LEN
lRet = vtblCall(Me.pIPattern, vTblOffset, vbLong, CC_STDCALL, selFlag)
End Sub
' __________________________________________ Helper Routines _______________________________________________
Private Sub DispGUID(objGuid As GUID)
Dim lRet As Long, sTmp As String, buf(100&) As Byte
lRet = StringFromGUID2(objGuid, VarPtr(buf(0&)), UBound(buf) - 1&)
sTmp = buf
End Sub
Private Function GetStrFromPtrW(ByVal lpString As LongPtr) As String
Dim lLength As Long, sBuffer As String
lLength = lstrlen(lpString)
sBuffer = Space$(lLength)
Call CopyMemory(ByVal StrPtr(sBuffer), ByVal lpString, lLength * 2&)
GetStrFromPtrW = sBuffer
End Function
Private Function vtblCall(ByVal InterfacePointer As LongPtr, ByVal VTableOffset As Long, ByVal FunctionReturnType As Long, ByVal CallConvention As Long, ParamArray FunctionParameters() As Variant) As Variant
Dim vParamPtr() As LongPtr
Dim pIndex As Long, pCount As Long
Dim vParamType() As Integer
Dim vRtn As Variant, vParams() As Variant
vParams() = FunctionParameters()
pCount = Abs(UBound(vParams) - LBound(vParams) + 1&)
If pCount = 0& Then
ReDim vParamPtr(0& To 0&)
ReDim vParamType(0& To 0&)
Else
ReDim vParamPtr(0& To pCount - 1&)
ReDim vParamType(0& To pCount - 1&)
For pIndex = 0& To pCount - 1&
vParamPtr(pIndex) = VarPtr(vParams(pIndex))
vParamType(pIndex) = VarType(vParams(pIndex))
Next
End If
pIndex = DispCallFunc(InterfacePointer, VTableOffset, CallConvention, FunctionReturnType, pCount, vParamType(0&), vParamPtr(0&), vRtn)
If pIndex = 0& Then
vtblCall = vRtn
Else
Call SetLastError(pIndex)
End If
End Function2- Interface code;
VBA Code:
Option Explicit
' ReadOnly Interface.
Property Get Name() As String
'
End Property
Property Get Role() As Long
'
End Property
Public Property Get Description() As String
'
End Property
Public Property Get HelpText() As String
'
End Property
Public Property Get State() As Long
'
End Property
Public Property Get Value() As String
'
End Property
Public Property Get DefaultAction() As String
'
End Property
Public Property Get KeyboardShortcut() As String
'
End Property
Public Property Get AcceleratorKey() As String
'
End Property
Public Property Get ControlType() As Long
'
End Property
Public Property Get HasKeyboardFocus() As Boolean
'
End Property
Public Property Get IsEnabled() As Boolean
'
End Property
Public Property Get ClassName() As String
'
End Property
Public Property Get IsOffScreen() As Boolean
'
End Property
Public Property Get ItemType() As String
'
End Property
Public Property Get ProcessID() As Long
'
End Property
Public Property Get LocalControlType() As String
'
End Property
Public Property Get Orientation() As String
'
End Property
Public Property Get ItemStatus() As Long
'
End Property
Public Property Get IsPassword() As Boolean
'
End Property
Public Property Get WindowHandle() As LongPtr
'
End Property
Public Property Get pIAutomation() As LongPtr
'
End Property
Public Property Get pITrueCond() As LongPtr
'
End Property
Public Property Get pIElementArray() As LongPtr
'
End Property
Public Property Get pIPattern() As LongPtr
'
End Property
Public Property Get pIElement() As LongPtr
'
End Property
Public Sub DoDefaultAction()
'
End Sub
Public Sub SelectMe()
'
End Sub
Public Sub GetClickablePoint(ByRef X As Long, ByRef Y As Long)
'
End Sub
Public Sub GetScreenBoundingRectangle(ByRef X As Long, ByRef Y As Long, nWidth As Long, nHeight As Long)
'
End Sub
