|
熊谷隆史 さん,こんばんは。あつしです。
まず、報告が遅くなりましたことをお詫びします。
そして、数々の事細かなアドバイス、本当にありがとうございました。
熊谷さんのアドバイスにより、解決に至ることが出来ました。
で、報告ですが、やはり自分の環境(XP_Home & Excell_2003)では、熊谷さんのソースそのままでは思ったように動作してくれませんでした。
その理由は自分には全くの??なのですが、以下に自分の修正した点を報告させていただきます。
簡単に言えば熊谷さんの二案の組み合わせなのですが、
Option Explicit
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
Sub test()
Dim hDlg As Long
Dim objIE As Object
Dim obj As Object
Set objIE = CreateObject("InternetExplorer.Application")
With objIE
.Visible = True
.navigate ""
End With
While objIE.Busy or objIE.Document.ReadyState <> "complete"
DoEvents
Wend
For Each obj In objIE.Document.all
If obj.tagName = "INPUT" Then
If obj.Value = "投 票" Then
objIE.Document.Script.setTimeout "javascript:obj.click", 1000
Sendkeys "{Enter}"
Exit For
End If
End If
Next
'ダイアログのウィンドウハンドルを取得。
Do
DoEvents
hDlg = GetLastActivePopup(objIE.hwnd)
Loop Until hDlg <> objIE.hwnd
'ダイアログのOKボタン押下
PostMessage hDlg, WM_COMMAND, vbOK, 0
End Sub
以上のように Sendkeys と APIの併用で予定の動作を行うことが出来ました。
(実際には複数のプロシージャーに分けて書いた物を、ひとつにまとめてみました。)
問題は、[59379]でも書いたように
Dim oIE As Object
Dim oSH As Object
Set oSH = CreateObject("Shell.Application")
For Each oIE In oSH.Windows
While oIE.Busy Or oIE.readyState <> 4
DoEvents
Wend
Next
のようなコードを書いても、投票結果のIEウィンドウが表示される前に、次の命令を実行し始めることです。
ただ、こちらはSleep等の命令を使い、十分な間隔をあけることで何とか対処できるのでしばらくはその手で行こうと思います。
それで不具合が出るようでしたら、またこちらに相談させていただきたく思います。
今回は本当にありがとうございました。
|
|