VBSでクリックをする処理


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を閉じその回のループは終了します。

回答の条件
  • 1人5回まで
  • 登録:
  • 終了:2012/09/03 17:50:57
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:gong1971 No.1

回答回数451ベストアンサー獲得回数70

ポイント500pt

※質問中の「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
他1件のコメントを見る
id:ty2016

おかげさまで無事解決することができました。

>ただ、これでもエラーは発生しました。
処理に多少時間が掛かっても良いようであれば、Sleepを入れるのも一つの手だと思います。

との事でしたので、エラーの起きる21行目の前にSleepを入れると上手くいきました。
これだと全くエラーが発生しないですね。

この度はお手数おかけ致しました。

2012/09/03 17:50:19
id:gong1971

以下、ご参考までに。

気になったので、その後も調べていたのですが、
↓こんな情報がありました。こちらの方が確実のようですね。

■ブラウザのビジー状態を判定するための,より良い方法
 (WSHでIEを自動操作する際,COMのアプリケーションイベントを利用する)
http://d.hatena.ne.jp/language_and_engineering/20100410/p1
※ただ、私はまだ試していません。

2012/09/03 19:05:10

その他の回答1件)

id:gong1971 No.1

回答回数451ベストアンサー獲得回数70ここでベストアンサー

ポイント500pt

※質問中の「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
他1件のコメントを見る
id:ty2016

おかげさまで無事解決することができました。

>ただ、これでもエラーは発生しました。
処理に多少時間が掛かっても良いようであれば、Sleepを入れるのも一つの手だと思います。

との事でしたので、エラーの起きる21行目の前にSleepを入れると上手くいきました。
これだと全くエラーが発生しないですね。

この度はお手数おかけ致しました。

2012/09/03 17:50:19
id:gong1971

以下、ご参考までに。

気になったので、その後も調べていたのですが、
↓こんな情報がありました。こちらの方が確実のようですね。

■ブラウザのビジー状態を判定するための,より良い方法
 (WSHでIEを自動操作する際,COMのアプリケーションイベントを利用する)
http://d.hatena.ne.jp/language_and_engineering/20100410/p1
※ただ、私はまだ試していません。

2012/09/03 19:05:10
id:ty2016

この度はご回答頂きありがとう御座います。

正常に動作致しましたが、4回に1度くらいの頻度で下記のエラーで止まってしまいます。

(天気予報かスポーツのところで発生します)

行:21

文字:2

エラー:オブジェクトがありません。:IE.document.body

コード:800A01A8

ソース:Microsoft VBScript実行時エラー

安定して動作させたいので、このエラーが起きないように解決できるでしょうか?

id:ina0089 No.2

回答回数108ベストアンサー獲得回数17

id:ina0089

ちがってたらホントすみません・・・;;

2012/09/03 17:04:33
  • id:ty2016
    失礼致します。補足につきましては「4回に1度」と書きましたが、「10回に1度」程度の間違いです。
  • id:ty2016
    実行中に何らかのエラーが起きた場合につきまして、下記の方針で対処したいと思います。

    ・何らかのエラーが起きてもポップアップダイアログは絶対に表示させない
    ・何らかのエラー起きた場合は下記のコードで強制終了します
    Dim objWShell '# この3行は気にしないでください
    Set objWShell = CreateObject("WScript.Shell") '# この3行は気にしないでください
    objWShell.Run "error.uws", vbNormalFocus, False '# この3行は気にしないでください
    WScript.quit '# 強制終了
  • id:Mook
    横槍で進みませんが、
    うまくいかないときは、10秒ぐらい表示をしようとした後ではないですか?

    t = Timer + 10
    Do Until (IE.busy = False) or (Timer > t)
    Loop

    となっていますが、タイムアウトした場合読込まない状態で先の処理に進むので、
    ソースから見た限りはそのあたりが怪しい気がします。
  • id:ty2016
    >うまくいかないときは、10秒ぐらい表示をしようとした後ではないですか?

    というご意見につきまして、試しにこれを5秒に変えてみましたが同様でした。

    エラーがどうしても起きてしまうようでしたら、

    上記の【対処】をして頂ければエラーには目を瞑ります。
  • id:a-kuma3
    横槍の横槍。

    Mook さんが言われているのは、10秒経っても表示が完了しない場合には、
    IE.busy = True のまま、document.body を参照しに行っちゃうので、
    エラーになるんだろう、ということでしょう。

    待ち時間を大きくすると、エラーになる頻度が少なくなると思います。
  • id:ty2016
    待ち時間の件ですが、表示には1秒もかかってません。
    なので待ち時間を大きくする意味はあまりない状況です。
    エラーになる時も、1秒もかからず読み込んでいます。

この質問への反応(ブックマークコメント)

トラックバック

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません