VBSで下記のような処理をしたいのですがコードをご教授頂いてもよろしいでしょうか?
配列に下記の3つのURLが入っています。
MSN【http://jp.msn.com/】MSN天気【http://weather.jp.msn.com/】MSNスポーツ【http://topics.jp.msn.com/sports】
For eachで各要素をIEで開く→クリック処理→IEを閉じる というループをします
---クリック処理の部分の詳細は下記になります---
①現在開いているURLに「weather」が含まれる場合
URLに「regin」が含まれるリンクをソースから全て抽出しランダムにどれかをクリック
②現在開いているURLに「sports」が含まれる場合
URLに「sports」が含まれるリンクをソースから全て抽出しランダムにどれかをクリック
③現在開いているURLに何も含まれない場合
何もせずにIEを終了
④現在開いているURLの“HTMLソース”に「これはダメです」という文字列が含まれる場合
スクリプトを強制終了
※URLに移動するだけではなく、あくまでクリックになります。
※サイトが10秒経っても読み込み完了しなければ、完了してなくともクリック処理へと進みます。
読み込みが完了しない等でクリック先がない場合は、IEを閉じその回のループは終了します。
※質問中の「regin」は「region」ですよね?修正してコードを組んでいます。
※強制終了は、元のurlとクリック後の両方で判断しました。
'# 初期設定 Dim open_url(2) Dim find_url() open_url(0) = "http://jp.msn.com/" open_url(1) = "http://weather.jp.msn.com/" open_url(2) = "http://topics.jp.msn.com/sports" For Each temp_url In open_url '# IE表示 Set IE = CreateObject( "InternetExplorer.Application" ) IE.Visible = true IE.Navigate(temp_url) '# IE待機処理 t = Timer + 10 Do Until (IE.busy = False) or (Timer > t) Loop '# 強制終了 If Instr(IE.document.body.innerHTML, "これはダメです") Then MsgBox "強制終了" WScript.quit End If '# キーワードの設定 kw = "" If Instr(temp_url, "weather") Then kw = "region" ElseIf Instr(temp_url, "sports") Then kw = "sports" End if If kw <> "" Then j = 0 ReDim find_url(IE.Document.Links.length) '# リンクのurlにキーワードが含まれるものを探す For i = 0 to IE.Document.Links.length - 1 If Instr(IE.Document.Links(i).href, kw) Then find_url(j) = i j = j + 1 End If Next '# リンクのurlにキーワードが含まれるものをランダムに開く Randomize IE.Document.Links(find_url(Int(Rnd * j))).Click '# IE待機処理 t = Timer + 10 Do Until (IE.busy = False) or (Timer > t) Loop '# 強制終了 If Instr(IE.document.body.innerHTML, "これはダメです") Then MsgBox "強制終了" WScript.quit End If End If '# IE終了 IE.Quit Set IE = nothing Next
※質問中の「regin」は「region」ですよね?修正してコードを組んでいます。
※強制終了は、元のurlとクリック後の両方で判断しました。
'# 初期設定 Dim open_url(2) Dim find_url() open_url(0) = "http://jp.msn.com/" open_url(1) = "http://weather.jp.msn.com/" open_url(2) = "http://topics.jp.msn.com/sports" For Each temp_url In open_url '# IE表示 Set IE = CreateObject( "InternetExplorer.Application" ) IE.Visible = true IE.Navigate(temp_url) '# IE待機処理 t = Timer + 10 Do Until (IE.busy = False) or (Timer > t) Loop '# 強制終了 If Instr(IE.document.body.innerHTML, "これはダメです") Then MsgBox "強制終了" WScript.quit End If '# キーワードの設定 kw = "" If Instr(temp_url, "weather") Then kw = "region" ElseIf Instr(temp_url, "sports") Then kw = "sports" End if If kw <> "" Then j = 0 ReDim find_url(IE.Document.Links.length) '# リンクのurlにキーワードが含まれるものを探す For i = 0 to IE.Document.Links.length - 1 If Instr(IE.Document.Links(i).href, kw) Then find_url(j) = i j = j + 1 End If Next '# リンクのurlにキーワードが含まれるものをランダムに開く Randomize IE.Document.Links(find_url(Int(Rnd * j))).Click '# IE待機処理 t = Timer + 10 Do Until (IE.busy = False) or (Timer > t) Loop '# 強制終了 If Instr(IE.document.body.innerHTML, "これはダメです") Then MsgBox "強制終了" WScript.quit End If End If '# IE終了 IE.Quit Set IE = nothing Next
おかげさまで無事解決することができました。
>ただ、これでもエラーは発生しました。
処理に多少時間が掛かっても良いようであれば、Sleepを入れるのも一つの手だと思います。
との事でしたので、エラーの起きる21行目の前にSleepを入れると上手くいきました。
これだと全くエラーが発生しないですね。
この度はお手数おかけ致しました。
以下、ご参考までに。
気になったので、その後も調べていたのですが、
↓こんな情報がありました。こちらの方が確実のようですね。
■ブラウザのビジー状態を判定するための,より良い方法
(WSHでIEを自動操作する際,COMのアプリケーションイベントを利用する)
http://d.hatena.ne.jp/language_and_engineering/20100410/p1
※ただ、私はまだ試していません。
この度はご回答頂きありがとう御座います。
正常に動作致しましたが、4回に1度くらいの頻度で下記のエラーで止まってしまいます。
(天気予報かスポーツのところで発生します)
行:21
文字:2
エラー:オブジェクトがありません。:IE.document.body
コード:800A01A8
ソース:Microsoft VBScript実行時エラー
安定して動作させたいので、このエラーが起きないように解決できるでしょうか?
ちがってたらホントすみません・・・;;
おかげさまで無事解決することができました。
2012/09/03 17:50:19>ただ、これでもエラーは発生しました。
処理に多少時間が掛かっても良いようであれば、Sleepを入れるのも一つの手だと思います。
との事でしたので、エラーの起きる21行目の前にSleepを入れると上手くいきました。
これだと全くエラーが発生しないですね。
この度はお手数おかけ致しました。
以下、ご参考までに。
2012/09/03 19:05:10気になったので、その後も調べていたのですが、
↓こんな情報がありました。こちらの方が確実のようですね。
■ブラウザのビジー状態を判定するための,より良い方法
(WSHでIEを自動操作する際,COMのアプリケーションイベントを利用する)
http://d.hatena.ne.jp/language_and_engineering/20100410/p1
※ただ、私はまだ試していません。