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

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

    Dim pElement As 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

    Dim IID_IHTMLWindow2 As GUID
    hr = IIDFromString(StrPtr("{332C4427-26CB-11D0-B483-00C04FD90119}"), VarPtr(IID_IHTMLWindow2))
    Dim win2 As MSHTML.IHTMLWindow2
    hr = IUnknown_QueryService(pElement, VarPtr(IID_IHTMLWindow2), VarPtr(IID_IHTMLWindow2), VarPtr(win2))
    If win2 Is Nothing Then Exit Sub

    Const url = "URLを指定"
    
    Dim IE As Object
    Set IE = CreateObject("Shell.Application").Windows.findwindowSW(url, Empty, 1, 0, 1)
    If IE Is Nothing Then Exit Sub

    If win2.Document Is IE.Document Then
        MsgBox "フレーム無し"
    Else
        MsgBox "フレーム有り"
    End If

End Sub