FC2ブログ

EXCELのVBAでIEをコントロールその1

VBAでインターネットエクスプローラーを制御するプログラムを作っていて課題となっていたのがポップアップメッセージへの対応とモダールダイヤログへの対応だった。
スクリプトから表示されるメッセージボックスやアラート、コンファームについては「hwnd = FindWindow("#32770", "Web ページからのメッセージ")」なかんじで対応できていたけど、モダールダイヤログはどうしていいのかわからなかった。
'-----------------
20:39 19/02/19 (火) 編集
本件について、職場のExce64Bitバージョンに対応すべく見直しをしていたら、不良個所が発見されたので訂正を加えた
'-----------------

さんざん調べて出てきたのがこれ
hWnd = FindWindow("Internet Explorer_TridentDlgFrame", vbNullString)
こいつでやっとこモダールダイヤログを捕まえることができた

さらには、このウインドウハンドルからIEのドキュメントを取得するすべも発見
ドキュメントさえ捕まえられれば、あとは通常のDOMへの処理となる

今回は前回記事にのせた参考ページから転載した一連のソースをのせておく
もとネタから変更を加えたのは
'-----編集したのはここだけ
のところ

だれかの参考になればと思う

〇おまけ
DOMの操作にはDOMの分析が必要
目でソースを眺めるのもいいのだが
それはあまりにも不効率

なので、DOM要素を分析してエクセルのシートに展開するVBAを作成済である
今回、モダールダイヤログのドキュメントを取得できたので
この分析にかければ、単純にメッセージボックスにOKキーをセンドするようなものではない
もっと複雑な処理も可能になる

DOM要素の分析ロジックソースについては
もう少しこなれてからご報告する

'--------------------------------------------------------------------
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
'--------------------------------------------------------------------
関連記事
スポンサーサイト



コメントの投稿

非公開コメント

更新ありがとうございます。
こちらのブログで勉強させて頂いてます。

私の実行環境ではうまく動かなくて、あまり知識はありませんが質問させて下さい。
WindowDOMファンクションについてなのですが、ファンクションの中でWindowDOMを記述しており永久に参照してしまうように思えるのですがいかがでしょうか?
もう一点、最後に記述されたIID_IHTMLDocumentはメンバの指定は無いのでしょうか?
よろしければ、ご教示下さい。

Re: タイトルなし

コメントありがとうございます
> 更新ありがとうございます。
> こちらのブログで勉強させて頂いてます。
> 私の実行環境ではうまく動かなくて、あまり知識はありませんが質問させて下さい。
σ(゚∀゚)ワタシのほうこそど素人なもんで、色々と間違いありきですいません(笑)
さて、自分でアップした内容を自分の環境でテストしましたら、なんとコンパイルエラーが(爆)
で、さっそく追加の訂正をさせていただきました

初回報告の内容では
UUID型の定義はあるものの、これを無視したLong型の変数に「魔法の定数」を設定してAPIに引き渡しておりました
先日の訂正では、これを本来のUUID型に「魔法の定数」を設定してAPIに引き渡すよう訂正しましたが
この引数を受け取るAPIの定義がLong型の「魔法の定数」を受け取る仕様のままでした
本日の変更はこれに対応したものです

> WindowDOMファンクションについてなのですが、ファンクションの中でWindowDOMを記述しており永久に参照してしまうように思えるのですがいかがでしょうか?
ObjectFromLresult lngRes, IID_IHTMLDocument, 0, WindowDOM
この部分のご指摘かと思われます
みの様にはすぐにお気づきいただけるかと思いますが
のちにこの記事を見たほかの方が理解できるように少し低いレベルでの説明をさせていただきます
ObjectFromLresultの部分はAPI関数の呼び出し、以後の部分はこれに引き渡す引数です

本日の訂正でAPI関数の定義は
Private Declare Function ObjectFromLresult Lib "oleacc" _
(ByVal lResult As Long, _
ByRef riid As UUID, _
ByVal wParam As Long, _
ByRef ppvObject As Any) As Long
となりました

第1引数のlngResはByVal lResult As LongとしてAPIに渡されます(これって、結果を返すLong型の引数なのにByValでいいのかという疑問を「今」発見、ただし、本文にあるように、結果の成否を検証していませんので、まぁいいか状態です)
第2引数のIID_IHTMLDocumentは、ByRef riid As UUID, _として、APIに参照渡しで引き渡されます
勝手な想像ではありますが、API関数に対して、InternetExplorer_Server内のメモリー配置を引き渡している「魔法の定数」ではないかと想像しています
第3の引数0はByVal wParam As Long, _に渡されるのですが、意味不明
第4の引数WindowDOMはByRef ppvObject As Anyとなりますが
これは、この関数の定義であるPrivate Function WindowDOM(ByVal hWnd As Long) As Objectの戻り値であるAs Objectにあるとおり
自関数の戻り値自身を参照渡しで引き渡し、APIの戻り値(Document objectのはず)を呼び出し側に返そうというものです

丁寧にやろうとするならば
Dim objDoc As Object
ObjectFromLresult lngRes, IID_IHTMLDocument, 0, objDoc
Set WindowDOM = objDoc
Set objDoc = Nothing
てな感じでしょうか

最後に
本件の記事はかなり放置プレイなネタでしたが
職場のWebベース業務システムの自動巡回処理には必須なものとして、最近進展がありました
近いうちに続きを書く予定ですので、そのときはまたコメントよろしくです

迅速丁寧な対応大変ありがとうございます。

新たに掲載して頂いたコードで本日完璧に動きました!
これで目的の機能を実装できそうです!

ObjectFromLresult関数はnothingのオブジェクトを渡してそこに目的のオブジェクトを返してくれる関数だったんですね!

Re: タイトルなし

調子にのって みの さんにも便利かもしれないツールをアップしときました
ついでに、この記事のVBAは職場の64Bitエクセルでは動かなかったので改修すみ
32,64両対応のソースも後日あげる予定です
( ̄ー ̄)/~~ジャ

管理人のみ閲覧できます

このコメントは管理人のみ閲覧できます

Re: ありがとうございました。

応援コメントありがとうございます
おもちゃ箱
Count from 2010/01/14

にほんブログ村 バイクブログ ドゥカティへ


カレンダー
10 | 2019/11 | 12
- - - - - 1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
最新記事
最新コメント
カテゴリ
月別アーカイブ
リンク
検索フォーム
RSSリンクの表示
ブロとも申請フォーム

この人とブロともになる

全記事表示リンク

全ての記事を表示する