「WEBからのメッセージ」が出ると、VBAの自動化プログラムが止まってしまい
毎回その部分だけ手動でクリックが必要でした。
どうにかVBAを止めることなく、この「WEBからのメッセージ」をクリックしたく
色々調べると、
どうやら 実行中のVBA制御がシステムウィンドウに持っていかれることが原因で、
VBA側に制御が返ってこないためにVBAが止まった状態になる、ということがわかり
VBAに制御を残したまま システムウィンドウに対してアプローチを行うために、
ココを参考にしながらJavascriptでシステムウインドウを出現させるコードを作成しました。
実行すると、
★の部分(If objButton(i).Value = ValueChar Then )で下記エラーがでます。
実行時エラー-2147352319(80020101) オートメーションエラーです。
調べても原因が分からずお知恵を貸していただきたく。
'呼び出し側 Sub テスト() ~省略~ Call ButtonClick(ie:=ie, ValueChar:="hoge") ~省略~ End Sub
Option Explicit '64bitのためPtrSafeをつけています Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _ (ByVal hwndParent As LongPtr, ByVal hwndChildAfter As Long, _ ByVal lpszClass As String, ByVal lpszWindow As String) As Long Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _ (ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Const WM_COMMAND As Long = &H111& Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long =========================================================== 'WEBからのメッセージ_ボタンを押す Sub ButtonClick(ie As InternetExplorerMedium, ValueChar As String) Dim objButton As HTMLInputButtonElement Dim objButtonCollection As Variant Set objButtonCollection = ie.document.getElementsByTagName("INPUT") For Each objButton In objButtonCollection Dim i As LongPtr Dim h As LongPtr i = 0 For i = 0 To objButtonCollection.Length - 1 If objButton(i).Value = ValueChar Then ★ 'Javascriptで対象のinputを押して「Web からのメッセージ」を表示させる。 'ポイントはJavascriptでクリックするからEXCEL側の制御が外れない。 ie.document.Script.setTimeout "javascript:document.getElementsByTagName('input')(" & i & ").click()", 200 '←200は0.2秒後にクリックしてねの意味 'Javascriptのsettimeoutで 0.2秒後にクリックされるから、Sleepで待っておく必要がある。 Sleep 2000 '「Webからのメッセージ」のウィンドウをキャッチする h = FindWindow("#32770", "Web ページからのメッセージ") 'OKボタンを押す PostMessage h, WM_COMMAND, 1, 0 Call waitIE(ie:=ie) Exit For End If Next i Next objButton Exit Sub
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。