VBA获取页面弹出框内容


有时候,需要获取页面弹出框(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
'--------------------------------------------------------------------