有时候,需要获取页面弹出框(Internet Explorer_TridentDlgFrame)的内容信息,这里是VBA的解决方案,有时间更新一下Python的解决方案。
'--------------------------------------------------------------------
Option Explicit
Private Declare Function RegisterWindowMessage Lib "user32" _
Alias "RegisterWindowMessageA" _
(ByVal lpString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" _
Alias "SendMessageTimeoutA" _
(ByVal hWnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any, _
ByVal fuFlags As Long, _
ByVal uTimeout As Long, _
ByRef lpdwResult As Long) As Long
'-----------------2019.2.20訂正 start
'Private Declare Function ObjectFromLresult Lib "oleacc" _
'(ByVal lResult As Long, _
'ByVal riid As Long, _ '<<<<<ここを参照設定のUUID型にしないとだめだった
'ByVal wParam As Long, _
'ByRef ppvObject As Any) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" _
(ByVal lResult As Long, _
ByRef riid As UUID, _
ByVal wParam As Long, _
ByRef ppvObject As Any) As Long
'-----------------2019.2.20訂正 end
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
(ByVal hwndParent As Long, _
ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As Long
'--------------------------------------------------------------------
Public Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
'--------------------------------------------------------------------
Sub ChildWindowDOM()
Dim objDocument As Object
Dim objA As Object
Dim hWnd As Long
'ハンドルの取得
hWnd = FindWindow("Internet Explorer_TridentDlgFrame", vbNullString)
hWnd = FindWindowEx(hWnd, 0&, "Internet Explorer_Server", vbNullString)
If hWnd = 0 Then
MsgBox "ハンドルが取得できませんでした。"
Exit Sub
End If
'IHTMLDocument取得
Set objDocument = WindowDOM(hWnd)
'-----編集したのはここだけ
'取得したダイヤログウインドウのID「OKButton」をクリック
objDocument.getElementById("OKButton").Click
'-----編集したのはここまで
Set objDocument = Nothing
End Sub
'-------------------------------------------------------------------------
Private Function WindowDOM(ByVal hWnd As Long) As Object ' IHTMLDocument
Dim lngMsg As Long
lngMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
If lngMsg = 0 Then
Exit Function
End If
Const SMTO_ABORTIFHUNG As Long = &H2
Dim lngRes As Long
SendMessageTimeout hWnd, lngMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lngRes
If lngRes = 0 Then
Exit Function
End If
'-----------------2019.2.19訂正 start
' Dim IID_IHTMLDocument(3) As Long
' IID_IHTMLDocument(0) = &H626FC520
' IID_IHTMLDocument(1) = &H11CFA41E
' IID_IHTMLDocument(2) = &HA00031A7
' IID_IHTMLDocument(3) = &H372608C9
' ObjectFromLresult lngRes, VarPtr(IID_IHTMLDocument(0)), 0, WindowDOM
Dim IID_IHTMLDocument As UUID
With IID_IHTMLDocument
.Data1 = &H626FC520
.Data2 = &HA41E
.Data3 = &H11CF
.Data4(0) = &HA7
.Data4(1) = &H31
.Data4(2) = &H0
.Data4(3) = &HA0
.Data4(4) = &HC9
.Data4(5) = &H8
.Data4(6) = &H26
.Data4(7) = &H37
End With
ObjectFromLresult lngRes, IID_IHTMLDocument, 0, WindowDOM
'-----------------2019.2.19訂正 end
End Function
'--------------------------------------------------------------------