[三流君]
[VBAで楽しく]
[VBA IE 操作]
三流君VBA:IE .Navigate about:blankで空白ページ表示 禁断の制御文GOTO文
リンク 分類:
[Document(文章)からデータを取得]
/ [Form入力処理]
/ [Linkリンク情報]
/ [Image画像情報]
/ [Frameフレーム処理]
サンプル:
[IEを使ったVBAのサンプル]
/ [小さなVBAでIE操作のコード]
メルマガ発行内容
やっと、下記、メルマガで発行した内容です。何かの参考となれば幸いです。
過去のメルマガ[IE操作系の記事一覧]もヨロシクです。
IE .Navigate about:blankで空白ページ表示 禁断の制御文GOTO文
こんにちは。AB型の変わり者 三流プログラマーのＫｅｎ３です。
今回は、
objIE.Navigate "about:blank" で空白のページを表示する
と
禁断の制御文？GoTo文
を少し書いてみます。
自分でも読み返すとあまり参考にならないのですが、
せっかく書いたので発行しちゃいます。
読者の声：あっ、そのネタ知ってるよ。内容は・・・だろ？
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
またまたぁ・・・先に心の中でネタ先読みしないでよ。
タイガー アンド ドラゴンの客じゃないんだからさ
/*
* １. 今回のキッカケ
*/
下記の質問を
http://www.ken3.org/vba/backno/vba050.html
から、いただく。
----
>WebBrowserを使ってある登録Webページに多量な登録データを自動で登録するツール
>を作っているのですが、まれにページ移動がうまく行かず、ループを途中で抜けて
>しまいます。ちゃんと期待するURLのページが開かれているのかチェックしているの
>ですが、それでもダメみたいです。何かこのような現象を回避する方法があれば
>ご教授頂きたいです。宜しくお願いします。
----
ご教授なんて言葉は嫌いなんだけど・・・といつもの口癖は置いといて、
^^^^^^
ページが正確に表示されたかの確認かぁ、、、どこで判断するんだろ？？？
/*
* ２．.ReadyState <> READYSTATE_COMPLETE を見るとか？？
*/
よく私が手抜きで使っている方法
Do While objIE.Busy = True
DoEvents
Loop
だと、無限ループだったり、
フレームや広告を読み終わった時点で.Busy=Falseとなったり不安定かな？
'↑これだけだと、別のフレーム読み込んだだけで、完了になる
'そこで、ステータスを見ないといけないんですね。
'.ReadyState = READYSTATE_COMPLETE
Do While objIE.ReadyState <> 4 '4の完了以外ループ
'何もしないループ（笑）
DoEvents
Loop
↑こんな感じで、.ReadyState <> 4 以外を待つのも１つの手だったりするし。
手抜きは良くないよ、手抜きは。
/*
* ３．究極の手抜き？n秒待つ
*/
タイミングによっては、.ReadyState見ててもおかしな動きをする時があるので
(ホントかよ、ガセネタばら撒くなよ、このうそつき君が)
手抜きで、データ読み込み指示後n秒待ってみたり。
objIE.Navigate "" & strURL 'アドレスを渡し表示する
'1秒表示を待つ 無駄にループさせる
time10 = DateAdd("s", 1, Now())
Do While True
DoEvents
If time10 < Now() Then Exit Do '時刻のチェック
Loop
'表示完了まで待つ 最大９秒待つ
time10 = DateAdd("s", 9, Now())
Do While objIE.Busy = True
DoEvents
If time10 < Now() Then Exit Do '時刻のチェック
DoEvents
Loop
objIE.stop
と、反応が安定しているwebサイトが相手の時はこんなこともよくやってます。
/*
* ４．空白ページの表示
*/
真っ白なページ、
CreateObject("InternetExplorer.application")
したばかりの何もしていない空白ページ
Sub OPEN_IE()
Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.application")
objIE.Visible = True
End Sub |
この初期状態にいつも持って行きたいなぁと思ったことありませんか？
単純に、
objIE.Navigate ""
でOKだろと思ったアナタ、不正解です。
これだとページが見つからないと怒ってきます。
で、正解は、
.Navigate "about:blank"
^^^^^^^^^^^^^^^^^^^^^^^
これで何も無い空白ページを表示する(空白ページに移動する)ことができます。
まぁ、何かの時、使ってみてください。
じゃなくって、この空白ページに移動を使って、
/*
* ５．飛ぶ前に必ず空白ページにする そんな姑息な一手
*/
objIE.Navigate "about:blank" 'ブランクを表示
で
ブランクページを表示することができます。
※空白の何も無いページ。
これを利用して、
目的のページに飛ぶ前にブランクページを表示させ、
ループ待ちの後、ページがブランクのままかチェックしてます。
※ページがブランク=読み込み失敗と判断する
objIE.Navigate "about:blank" '空白ページを表示
objIE.Navigate "" & strURL 'アドレスを渡し表示する
みたいに上記２行をいつもペアで使う。
.Navigate "about:blank"
これで瞬時に空白・ブランクページになる。
.Navigate "" & strURL
で読み込み開始、
ここで何かしらの原因でページを読めない時はブランクページのままなので、
If objIE.Document.URL = "about:blank" Then
↑こんな感じで、ドキュメントのURLがabout:blankのままかチェックすれば、
ページが読み込まれたか？(空白以外に切り替わったか？)がチェックできます。
※私、ADSL回線なのですが、１０分以上連続処理していると途中よく切れるので、
せっかく自動巡回してても、タイムアウトで前のページを連続で取り込むバグが
発生してました。
※※１０分以上も巡回するなって・・・なにやってんだか・・・
/*
* ６．我流のサンプル 禁断の制御文GOTO入り
*/
GOTO文を使った手抜きで参考になるかわかりませんが、
下記のようにして現在は巡回時の回線切れや相手側の無反応、
そんなエラーを回避してます。
※それでもエラーのときありますが、頻度は減りました。
'---- 連続読み込みのサンプル 楽天のランキング30個チェック時の ------
'リンク先へ飛び、タイトルとURLをGetする
For nYLINE = 10 To 40
nERR_CNT = 0 'エラーのカウンタを初期化する
START002:
If nERR_CNT = 5 Then '5回エラーならあきらめる
Cells(nYLINE, 4) = "読み込みに失敗しました"
MsgBox "読み込みに失敗しました"
Exit Sub 'プログラムを抜ける
Else
nERR_CNT = nERR_CNT + 1 'エラー回数を＋1
End If
Cells(nYLINE, "A").Select
strURL = Trim(Cells(nYLINE, "C")) 'URL代入
If strURL = "" Then Exit For
objIE.Navigate "about:blank" 'ブランクを表示
objIE.Navigate "" & strURL 'アドレスを渡し表示する
'1秒表示を待つ 無駄にループさせる
time10 = DateAdd("s", 1, Now())
Do While True
DoEvents
If time10 < Now() Then Exit Do '時刻のチェック
Loop
'表示完了まで待つ 最大９秒待つ
time10 = DateAdd("s", 9, Now())
Do While objIE.Busy = True
DoEvents
If time10 < Now() Then Exit Do '時刻のチェック
DoEvents
Loop
objIE.stop
'タイトルを書き込む
Cells(nYLINE, "D") = objIE.Document.Title
Cells(nYLINE, "E") = objIE.Document.URL
'空白のチェック
If objIE.Document.URL = "about:blank" Then
GoTo START002 'エラー(空白のまま)の時、先頭に強引に飛ばす
End If
'
If Left(Cells(nYLINE, "D"), 6) = "【楽天市場】" Then
Cells(nYLINE, "D") = "'<em>" & Mid(Cells(nYLINE, "D"), 7) & "</em>"
End If
If InStr(Cells(nYLINE, "D"), "エラー") > 0 Then
Cells(nYLINE, "D") = "ページのエラーです"
'表示完了まで待つ
time10 = DateAdd("s", 10, Now())
Do While objIE.Busy = True
DoEvents
If time10 < Now() Then Exit Do
DoEvents
Loop
Cells(nYLINE, "E") = objIE.Document.URL '再度ロケーションをセット
End If
Next
' ---- 途中を抜粋 -----
ポイントは、
objIE.Navigate "about:blank" 'ブランクを表示
objIE.Navigate "" & strURL 'アドレスを渡し表示する
で、空白にしてから目的のURLを表示
n秒待ったり、.Busyを見たりしてから、
If objIE.Document.URL = "about:blank" Then
GoTo START002 'エラー(空白のまま)の時、先頭に強引に飛ばす
End If
.Document.URL = "about:blank"でURLが移動されたか再度チェック、
空白(about:blank)のままだったら、
先輩方に嫌われている制御文GOTO文で先頭に飛ばしてます。
GoTo START002でラベルSTART002:に飛ばす
(ループのカウンターを増やさずに、先頭に処理を戻してます)
START002:
If nERR_CNT = 5 Then '5回エラーならあきらめる
Cells(nYLINE, 4) = "読み込みに失敗しました"
MsgBox "読み込みに失敗しました"
Exit Sub 'プログラムを抜ける
Else
nERR_CNT = nERR_CNT + 1 'エラー回数を＋1
End If
のエラーカウント処理で判断してます。
意外とGOTO文も便利でしょ。(オイオイそんなこと書いて大丈夫？クレーム来るぞ)
あとは、アレンジしてみてください。(なんて無責任な・・・)
何かの参考となれば幸いです。
/*
* ７．終わりの挨拶
*/
今回は、
.Navigate "about:blank" で 空白ページを表示
と
GOTO文で強引に制御する
そんな話でした。
プログラム作りは
^^^^^^^^^^^^^^^^
う〜ん・・・
まぁ、人それぞれ、十人十色、百社百色だけどね。
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
禁断のGoTo文を使う時は、周りの空気を読んでから使ってね。
※絶対禁止なんて人達も居るので・・・
GOTO文の制御でクレームメールが来る予感を感じつつ
今回も逃げるように失礼します。
ＡＢ型の変わり者、三流プログラマーのＫｅｎ３でした。
ページフッター リンクや広告、質問送信など
三流解説を読んでいただき、どうもです。ここから下は、三流君宛のメッセージ送信や 三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、※質問や感想は、気軽に送ってくださいね。
質問や要望など メッセージを送る(三流君に連絡する)
三流プログラマーのKen3 が 皆さんの質問にお答えします
と カッコつけて言っても、実力不足ですべての質問に回答することはできないのが現実なのですが、できる範囲で 三流的な逃げ手 や 解決方法 を探します(回答します)。
感想や質問・要望・苦情など 三流君へメッセージを送る。
時間的余裕のある要望・質問・苦情の場合は、下記のフォームからメッセージを送ることができます。
急ぎで連絡がほしい、そんな時は:[三流君連絡先]に連絡してください。
[トップページへ 戻る]
/ [VBA TOP]
/ [WebBrowser IEの操作 TOPへ]