三流君VBA:IE .Navigate about:blankで空白ページ表示 禁断の制御文GOTO文

発行内容

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文の制御でクレームメールが来る予感を感じつつ
今回も逃げるように失礼します。

ＡＢ型の変わり者、三流プログラマーのＫｅｎ３でした。

フィードバック

評価・感想

ページフッター(リンクや広告など)

書籍の購入

コンピュータ書籍の発送がハヤイ専門店

コンピュータの本・専門店

※種類が豊富で探し易いです。※在庫ありが48時間以内発送が急ぎで資料や書籍がほしい時、とても助かります。 お奨め本の目次を見るだけでも勉強になったり

amazon.co.jpでキーワード別チェック