moug

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 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




    On Error Resume Next

    Debug.Print pElement.className, "class"
    
    Debug.Print pElement.Name, TypeName(pElement)
    Debug.Print pElement.ID, "id"
    Debug.Print pElement.form.Name, "form"
    On Error GoTo 0

    Const url = "http://ja.chordwiki.org/search2.html"
    Dim IE
    Set IE = CreateObject("Shell.Application").Windows.findwindowSW(url, Empty, 1, 0, 1)
    If IE Is Nothing Then Exit Sub


    Dim i&
    i = 0
    For Each v In IE.document.getElementsByTagName("INPUT")
        If v Is pElement Then
            Debug.Print i
            Exit For
        End If
        i = i + 1
    Next


End Sub