Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

22449 / 76807

←次へ　｜　前へ→


	【59741】Re:IE操作中のポップアップの処理

熊谷隆史 - 09/1/6(火) 12:06 -


	引用なし

	パスワード

▼あつしさん：
参照設定の仕方は、調べてください。
乱暴な言い方をすれば標準モジュール以外が、オブジェクトモジュールです。
※ 本来はクラスモジュールを使うのですが、ベタに記述しています。

---
Option Explicit
'参照設定
'Microsoft HTML Object Library
'Microsoft Internet Controls
' オブジェクトモジュール

Private Declare Function GetLastActivePopup Lib "user32" _
　　　　(ByVal hwndOwnder As Long) As Long
Private Declare Function PostMessage Lib "user32" _
　　　　Alias "PostMessageA" (ByVal hwnd As Long, _
　　　　ByVal Msg As Long, ByVal wParam As Long, _
　　　　ByVal lParam As Long) As Long
Private Const WM_COMMAND = &H111

Private WithEvents objIE As InternetExplorer
Private WithEvents objIE2nd As InternetExplorer
Private flgIE As Boolean
Private flgIE2nd As Boolean

Private Sub test()

　　Dim hDlg As Long
　　Dim i As Long
　　Dim obj As MSHTML.HTMLInputElement
　　Dim DOM As MSHTML.HTMLDocument
　　Dim o As MSHTML.HTMLWindow2
　　Dim timerID As Long

　　flgIE = False
　　flgIE2nd = False
　　Set objIE = New InternetExplorer
　　objIE.Visible = True
　　objIE.Navigate "" ' ←実際のURLを指定。

　　'最初のIEのDocumentCompleteイベント待ち
　　Do
　　　　DoEvents
　　Loop Until flgIE = True
　　Set DOM = objIE.Document

　　For Each obj In DOM.getElementsByTagName("INPUT")
　　　　If obj.Value = "投　　票" Then
　　　　　　Exit For
　　　　End If
　　　　i = i + 1
　　Next
　　Set o = DOM.Script
　　timerID = o.setTimeout("jscript:document.getElementsByTagName('INPUT').item(" & i & ").click()", 1000, "VBScript")

　　'メッセージダイアログのウィンドウハンドルを取得。
　　Do
　　　　DoEvents
　　　　hDlg = GetLastActivePopup(objIE.hwnd)
　　Loop Until hDlg <> objIE.hwnd
　　o.clearTimeout timerID

　　'メッセージダイアログのOKボタン押下
　　PostMessage hDlg, WM_COMMAND, vbOK, 0

　　'もう一つのIEのDocumentCompleteイベント待ち
　　Do
　　　　DoEvents
　　Loop Until flgIE2nd = True

End Sub

Private Sub objIE_DocumentComplete(ByVal pDisp As Object, URL As Variant)
　　If pDisp Is objIE Then
　　　　flgIE = True
　　End If
End Sub

Private Sub objIE_OnQuit()
　　Set objIE = Nothing
End Sub

Private Sub objIE_NewWindow2(ppDisp As Object, Cancel As Boolean)
　　Set objIE2nd = New InternetExplorer
　　Set ppDisp = objIE2nd
End Sub

Private Sub objIE2nd_DocumentComplete(ByVal pDisp As Object, URL As Variant)
　　If pDisp Is objIE2nd Then
　　　　flgIE2nd = True
　　End If
End Sub

Private Sub objIE2nd_OnQuit()
　　Set objIE2nd = Nothing
End Sub

12 hits

▼

【59038】IE操作中のポップアップの処理 あつし 08/11/24(月) 15:26