Accessible ObjからIE Obj
VBAからIE９のタブ機能を操作しようと悪戦苦闘しております。
詳しく申し上げると、最前面に表示されているIEの
アクティブなタブを確実につかんだうえで、
そのページのDOMを操作したいです。
色々調べていったところ、IAccessibleインタフェースの
中にあるaccStateプロパティを見れば、タブがアクティブになっているかどうか
判別できるところまでたどり着きました。
以下のページを参考にしました。
http://mt-soft.sakura.ne.jp/kyozai/excel_apps/tab-ctrl/index-jump.html?pg_02.html
※C#を多少かじったので、クラス等の知識は微量ですがあります。
上記のサイトを参考に実際にコードを組んでいたのですが、
AccessibleオブジェクトとIEオブジェクトを行き来する方法が
わからず、せっかくタブの状態がわかっても
それをメインのコードに反映することができません。
Accessibleオブジェクトの階層を上のほうまで辿って行けば、
IEオブジェクト(Shell Windowオブジェクト？）にたどり着く？
ということも考えたのですが、辿り方がわからず頓挫しております。
最前面のIEはFindWindow関数でハンドルを取得し、
それをAccessibleインターフェイスに渡す方法で
accStateを取得しています。
Sub ie_find()
Dim IE As Object
Dim hWnd As Double
hWnd = FindWindow("IEFrame", vbNullString)
'タブのリスト
Dim TabList()
'タブリスト作成
MakeTabList hWnd, TabList
For i = 0 To UBound(TabList)
If TabList(i).accState(CHILDID_SELF) = 2097154 Then
Next i
’ここにいれる処理がわかりません。
’IEオブジェクト⇔Accessibleオブジェクトの
’方法があれば処理できると思います。
End Sub
Private Sub MakeTabList(hWnd As Double, ByRef TabList())
'
' タブ一覧生成
'
Dim hWndChild As Long
Dim Cnt As Long, i As Long
Dim ClassName As String
Call Class_Initialize 'AccessibleオブジェクトのUUID設定
hWndChild = GetDirectUIHWND(hWnd, "CommandBarClass") 'IE9以前
If hWndChild = 0 Then hWndChild = GetDirectUIHWND(hWnd, "WorkerW") 'IE10以降
If hWndChild = 0 Then Exit Sub
Dim objAcc As IAccessible, v
AccessibleObjectFromWindow hWndChild, OBJID_CLIENT, IID_IAccessible, objAcc
If Not (objAcc Is Nothing) Then
Dim Children() As Variant
Dim Count1 As Long, Count2 As Long
Dim retCount As Long
Count1 = objAcc.accChildCount
ReDim Children(Count1 - 1)
Call AccessibleChildren(objAcc, 0, Count1, Children(0), retCount) '子オブジェクト
For i = 0 To objAcc.accChildCount - 1
If TypeOf Children(i) Is IAccessible Then
If Children(i).accRole(CHILDID_SELF) = ROLE_SYSTEM_PAGETABLIST Then 'タブ行？
Count2 = Children(i).accChildCount
ReDim TabList(Count2 - 1)
'タブの一覧を生成 「タブ」と「新しいタブ」のボタン
Call AccessibleChildren(Children(i), 0&, ByVal Count2, TabList(0), retCount)
Exit For
End If
End If
Next i
End If
End Sub
Private Function GetDirectUIHWND(hWnd As Double, ClassName As String) As Long
'
' DirectUIHWND のウィンドウハンドルを取得
'
Dim hWndChild As Long
hWndChild = FindWindowEx(hWnd, 0, ClassName, vbNullString)
If hWndChild <> 0 Then hWndChild = FindWindowEx(hWndChild, 0, "ReBarWindow32", vbNullString)
If hWndChild <> 0 Then hWndChild = FindWindowEx(hWndChild, 0, "TabBandClass", vbNullString)
If hWndChild <> 0 Then hWndChild = FindWindowEx(hWndChild, 0, "DirectUIHWND", vbNullString)
GetDirectUIHWND = hWndChild
End Function
Private Sub Class_Initialize()
'AccessibleオブジェクトのUUID設定
With IID_IAccessible
.Data1 = &H618736E0
.Data2 = &H3C3D
.Data3 = &H11CF
.Data4(0) = &H81
.Data4(1) = &HC
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H38
.Data4(6) = &H9B
.Data4(7) = &H71
End With
End Sub
どうかこの辺詳しい方、ご教示よろしくお願いいたします。
お礼
参考URLありがとうございます！ 助かりました☆ 以下のコードでなんとかエラー解決できました。 ------------------------------------------------------ 'SetForegroundWindowの定義 Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long 'FindWindow関数の定義 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long '************************************************************ 'IEのウィンドウハンドルを取得 '************************************************************ Dim hwnd As Long hwnd = FindWindow("IEFrame", vbNullString) '見つからなければ戻り値0 '************************************************************ 'ウィンドウを前面に表示する '************************************************************ If hwnd = 0 Then MsgBox "IEが起動していません" Exit Sub End If SetForegroundWindow hwnd '============================================= 'チェックボックス検索開始 '============================================= Dim i as Integer Dim Browser1 As Object Dim elm As Object Dim objShell As Object Dim ShWins As Object Dim IE As Object Const READYSTATE_COMPLETE As Long = 4 'IEオブジェクト状態(4=読み込み完了) Set objShell = CreateObject("Shell.Application") Set ShWins = objShell.Windows() For Each IE In ShWins Set Browser1 = IE Exit For Next '次の画面が表示されるまで待機 While Browser1.ReadyState <> READYSTATE_COMPLETE While Browser1.Busy = True DoEvents Wend Wend Set elm = Browser1.document.getElementsByTagName("INPUT") For i = 0 To elm.Length - 1 'If (elm(i).Name = "q") Then elm(i).Focus: Exit For MsgBox elm(i) Next i ------------------------------------------------------ ただ、メッセージボックスに何も表示されないのです。。。 DoEventsってほんとに重いですねぇ。
補足
MsgBox elm(i) に MsgBox elm(i).Type がぬけてました。すみません。