マウスカーソル直下の要素を取得

Module1.bas

'目的の要素を選択
Sub Main()
    Application.OnTime Now + TimeSerial(0, 0, 2), "GetSub"
End Sub

Module2.bas

Option Explicit


Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Declare PtrSafe _
Function IIDFromString Lib "ole32.dll" ( _
    ByVal lpsz As LongPtr, _
    ByVal lpiid As LongPtr _
) As Long

                                
Private Declare PtrSafe _
Function IUnknown_QueryService Lib "shlwapi.dll" ( _
    ByVal punk As IUnknown, _
    ByVal guidService As LongPtr, _
    ByVal riid As LongPtr, _
    ByVal ppvOut As LongPtr _
) As Long

Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As LongPtr) As LongPtr
#If Win64 Then
Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" _
        (ByVal arg1 As LongPtr, _
        arg2 As IAccessible, arg3 As Variant) As Long
#Else
Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" _
        (ByVal arg1 As Long, ByVal arg2 As Long, _
        arg3 As IAccessible, arg4 As Variant) As Long
#End If
Private Declare PtrSafe Function GetCursorPos Lib "user32" _
        (arg1 As Any) As Long


Private Declare PtrSafe Function WindowFromAccessibleObject Lib "Oleacc" _
        (ByVal arg1 As IAccessible, _
        arg2 As LongPtr) As Long
Private Declare PtrSafe Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare PtrSafe Function ObjectFromLresult Lib "Oleacc" _
                                (ByVal arg1 As LongPtr, _
                                arg2 As Any, _
                                ByVal arg3 As LongPtr, _
                                arg4 As Any) As Long

         
Public Sub GetSub()

    Dim pt(0 To 1) As Long
    GetCursorPos pt(0)
    Dim acc As IAccessible
    Dim v As Variant

#If Win64 Then
    Dim lnglngpt As LongPtr
    lnglngpt = pt(1) * &H100000000^ Or pt(0)
    AccessibleObjectFromPoint lnglngpt, acc, v
#Else
    AccessibleObjectFromPoint pt(0), pt(1), acc, v
#End If

    If acc Is Nothing Then Exit Sub
    'Debug.Print acc.accName, acc.accValue
    
    Dim h As LongPtr
    WindowFromAccessibleObject acc, h
    If h = 0 Then Exit Sub

    Dim pElement As Object 'IHTMLElement
    Dim iid As GUID
    IIDFromString StrPtr("{3050f1ff-98b5-11cf-bb82-00aa00bdce0b}"), VarPtr(iid)
        
    Dim hr As Long
    hr = IUnknown_QueryService(acc, VarPtr(iid), VarPtr(iid), VarPtr(pElement))
    If pElement Is Nothing Then Exit Sub

    Debug.Print pElement.tagname

End Sub