| |
▼あつし さん：
参照設定の仕方は、調べてください。
乱暴な言い方をすれば標準モジュール以外が、オブジェクトモジュールです。
※ 本来はクラスモジュールを使うのですが、ベタに記述しています。
---
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 08/11/24(月) 15:39 -
