【VBA】sleepかwaitをどこに書き込めば

質問

ExcelでWebスクレイピングを行うための、VBAのソースをご教示頂きました。
過去の質問｜https://okwave.jp/qa/q9420082.html

このソースは完璧に動くのですが、googleに負荷を掛けてしまい、100件ほど抽出するとエラーが出て使えなくなってしまいます。
そこでsleepやwaitを使って、間隔を空けて実行させたいと考えています。
以下のどの部分に追加すれば良いのか、教えてください！
お願い致します。
―――――――――――――――――――
'
Option Explicit
'
Sub Macro1()
'
　　Dim SheetW As Worksheet
　　Dim SheetO As Worksheet
　　Dim Start As Integer
　　Dim URL As String
　　Dim NowCell As String
　　Dim RowI As Integer
　　Dim RowO As Integer
　　Dim RowEnd As Integer
　　Dim Col As Integer
　　Dim ColEnd As Integer
'
　　Set SheetO = ActiveSheet
　　[A10:C10] = Array("番号", "URL", "説明")
　　[A11:C1048576].Clear
　　Set SheetW = Sheets.Add
　　SheetW.Name = "Webクエリ"
　　RowO = 11
　　ColEnd = [A5].End(xlToRight).Column
'
　　For Start = SheetO.[B2] To SheetO.[C2] Step SheetO.[D2]
DoEvents
　　　　URL = SheetO.[B1] & SheetO.[C1] & SheetO.[D1] & Start
　　　　With ActiveSheet.QueryTables.Add( _
　　　　　　Connection:="URL;" & URL, _
　　　　　　Destination:=[A1])
　　　　　　.Name = "Google検索結果"
　　　　　　.WebSelectionType = xlEntirePage
　　　　　　.WebFormatting = xlWebFormattingAll
　　　　　　.BackgroundQuery = False
　　　　　　.Refresh
　　　　End With
'
　　　　With SheetO
　　　　RowI = [A:A].Find(.[B3]).Row + 1
　　　　RowEnd = Cells(Rows.Count, "A").End(xlUp).Row
　　　　While Not Cells(RowI, "A") Like .[B4] And _
　　　　　　　RowI < RowEnd
　　　　　　NowCell = Cells(RowI, 1)
'
　　　　　　For Col = 2 To ColEnd
'
　　　　　　　　If NowCell Like .Cells(5, Col) Then
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next Col
'
　　　　　　If Cells(RowI, 1).Hyperlinks.Count > 0 And Col > ColEnd Then
　　　　　　　　.Cells(RowO, "A") = RowO - 10
　　　　　　　　.Cells(RowO, "C") = NowCell
　　　　　　　　NowCell = Cells(RowI, "A").Hyperlinks(1).Address
'　　　　　　　 SheetO.Cells(RowO, "B") = NowCell
　　　　　　　　.Hyperlinks.Add Anchor:=.Cells(RowO, "B"), _
　　　　　　　　　　Address:=NowCell, _
　　　　　　　　　　TextToDisplay:=NowCell
　　　　　　　　RowO = RowO + 1
　　　　　　End If
　　　　　　RowI = RowI + 1
　　　　Wend
　　　　End With
　　Next Start
' "Webクエリ"シート削除
　　Application.DisplayAlerts = False
　　SheetW.Delete
　　Application.DisplayAlerts = True
End Sub

回答No.5

SI299792

BusyWait IE
の後にSleep を置いてみて下さい。効果があるかもしれません。後、
C1　excel+vba
にしてみて下さい。但し、できる可能性は低いです。

回答No.4

SI299792

「職場で～」余計なことを聞いてしまいました。どうでもいいことですが、ちょっと気になって。
　Sleep を置くなら、前述の通り、Next Startの上ですが、それでダメたということは、Sleep を置いてもダメです。
　お願いがあるのですが、Yahoo でできるかどうか試してください。
B1　https://search.yahoo.co.jp/search?p=
D1　&b=
B2　1 （Yahoo は１から始まる）
C4　次へ>
他の項目は、前と同じ。
　後、入力ミスはないと思いますが、念のため確認してください。
　できる、できないにかかわらず、閉じないで下さい。Googleでやる方法はあるかもしれません。

回答No.3

SI299792

うまく行きませんでしたか。D1　&start= 又は &filter=0&start= と書きましてが、どちらにしましたか？（念のための確認です）。私のパソコンではうまくいっているので、私にはわかりません。B5を１にすれば、IEを閉じる前に一時停止するので、メッセージをしっかり見ることができます。一時停止機能はその為につけました。
　私も最初そのメッセージが出たのですが、１時間後再実行したら成功しました。１ページ目からこのメッセージが出るのなら、前に実行した時のアクセス禁止が続いている可能性が高いです。多分人間でな考えれれないほどのスピードで次のページを見るからロボットと判断されるので、１ページ目はロボットとわからないはずです。時間がおいてやってみて下さい。
　それでも駄目なら、Next Startの上に
　　　　Sleep [B6]
を置いて、[B6]を1000位にしてやってみて下さい。又は、B5を１にして、１ページ毎に継続ボタンを押して下さい。１度このエラーが出たら、アクセス禁止が続くので、必ず時間をおいてやってみて下さい。
　それでも駄目ならお手上げです。低速のパソコンに買い替えて下さい（笑）。
　ところで、土日返事がなく、月曜日に返事があったということは、職場でやっているのですか？

補足

今回もご回答ありがとうございます！

まず「職場で～」という質問ですが、個人用途です！
このアカウントも、10数年前にアットホームダットというドラマを見て、作った個人のアカウントです（笑）
平日は目を酷使する仕事をしているので、土日はパソコンから離れた生活（読書や美術館etc.）をしています。スマホでも確認できますが、長文を打つときや、理解を深めたいときはパソコンで確認しています。

で、話しを戻します。
D1については、両方とも試しましたが同じでした。
そして今回教えて頂いた方法でもダメでした（涙）
ロボットの表示がされない場合もあるのですが、
そもそもExcelにURL/説明ともに、１つも表示（反映）されません。
エラーも出ず、読み込んでいる挙動はあるのですが、ダメでした。
何度か試し、1度だけ1行分だけ表示されたことがありました。
しかしそれ以降は、Excelがまっさらorロボットと認識されるか…
どちらかでした。

低速とは、どこからいうのか分かりませんがｗ
手元にあるPCでは残念ながら、試せません。

最後に最初に教えて頂いたソースに、もしsleepやwaitを入れるとしたら、どこになりますか？勉強のため教えてください。

回答No.2

SI299792

勝手な判断とは…私が 100件程しか必要なかったので、自分に合わせて作りました。
　色々試していると、「お使いのコンピュータ ネットワークから通常と異なるトラフィックが検出されました。このページは、リクエストがロボットではなく実際のユーザーによって送信されたことを確かめるものです。」というメッセージが出ました。ロボットとみなされての、アクセス禁止が原因のようです。実際にロボットだから仕方ありません。
　私は、 200件位まで大丈夫で、前記の方法でできました。スペックの差でしょうか。遅いパソコンにこんなメリットがあったとは。
　プログラムを作ったのは、Web クエリを使う方法があると知ったからです。いちいちIEを起動しないので実行速度が上がると思いました。
　IEを起動して処理する方法なら、作った経験があります。昔作った物を手直ししました。今の所、エラーは出ていません。
B1　http://www.google.co.jp/search?q=
C1　excel vba
D1　&start= 又は &filter=0&start=
B2　0
C2　1000
D2　10
B3　innerHtml
C3　*<b>*
C4　????次へ
B5　FALSE
と入力して下さい。以下、単なるコメントなので、入れても入れなくてもいいです。
A1　アドレス
A2　ページ
A3　出力条件
A4　次ページ有無
B4　innerText
A5　表示
A10 ＵＲＬ
B10 説明
　リングは検索結果以外にもいろいろあります。このようなプログラムを作る時は、必要な物をどうやって見分けるか悩みます。検索結果には太字が使われているので、<b> のあるリンクは必要と判断しています。
　B5はTrueにするとIEが表示され、すぐに消えます。面白いけれどうざいです。１にすると１ページ処理する度に止まります。デバッグのための機能です。
'
DefInt A-Z
' 一時停止
Declare Sub Sleep Lib "kernel32" ( _
　　ByVal dwMilliseconds As Long)
'
Sub Macro1()
'
　　[A11:B1048576].Clear
　　Row = 11
'
　　For Start = [B2] To [C2] Step [D2]
　　　　[E1] = Start
'
　　　　If Not Macro1Loop(Row) Then
　　　　　　Exit For
　　　　End If
　　Next Start
End Sub
'
Function Macro1Loop(Row) As Boolean
'
　　Dim IE As Object
　　Dim Links As Object
　　Dim NameProp As String
'
　　Set IE = CreateObject("InternetExplorer.Application")
　　IE.Visible = [B5]
　　IE.Navigate [B1] & [C1] & [D1] & [E1]
　　BusyWait IE
'
　　For Each Links In IE.Document.Links
　　　　NameProp = Links.InnerHtml
'
　　　　If [B3] = "nameprop" Then
　　　　　　NameProp = Links.NameProp
　　　　End If
'
　　　　If NameProp Like [C3] Then
　　　　　　ActiveSheet.Hyperlinks.Add Anchor:=Cells(Row, "A"), _
　　　　　　　 Address:=Links.Href, _
　　　　　　　 TextToDisplay:=Links.Href
　　　　　　Cells(Row, "B") = Links.InnerText
　　　　　　Row = Row + 1
　　　　ElseIf Links.InnerText Like [C4] Then
　　　　　　 Macro1Loop = True
　　　　End If
　　Next Links
'
　　If [B5] = 1 Then
　　　　Stop
　　End If
　　IE.Quit
　　Set IE = Nothing
End Function
'
Sub BusyWait(IE As Object)
'
　　While IE.Busy Or IE.ReadyState < 4
　　　　DoEvents
　　　　Sleep 100
　　Wend
End Sub

B1　https://okwave.jp/list/new_question/
B2　1
C2　5
D2　1
B3　nameprop
C3　q#*
C4　次へ >
にすればOKWAVEに使えます。単なる遊びですが。

補足

ご回答ありがとうございます！
早速、確認させて頂きました。
全て入力して実行したところ、エラーは出ませんでしたが、何も起こりませんでした。
表示をFLASH⇒TRUEに変更したところ、googleのロボットチェックの画面が出ているシーンが一瞬出てきました。
…これ以上は難しいのでしょうか？

回答No.1

SI299792

返事が遅れてすみません。私の勝手な判断で、 100件位できればいいだろうと思い、最後まで見ることは想定していませんでした。色々調べたのですが、このエラーが出ると、しばらく使えないので、調べるのに時間がかかりました。

このエラーの原因は２つ考えられます。
無いページを表示しようとした。
“Excel Vba” の検索結果は　126件位しかなく、13ページ以降を無理に出そうとしたからです。
上記の理由でストッパーを付けませんでした。１番簡単な対策は、B3を 125以下にすることです。時間によって件数が変わるので、実行前に調べる必要があります。

13ページ目を見ると、
「最も的確な検索結果を表示するために、上の 126 件と似たページは除外されています。」と書いてありました。全て検索したい場合、
A4　&filter=0&start=
にしてください。そうすれば、 700件位でます。

１度に沢山取ろうとしても、このエラーは出るようです。
Waitを入れるとすればループ内のどこでもいいですが、Nextの上が一番いいでしょう。やってみたけれど効果はありませんでした。Waitを入れても効果はないと思います。
１度に取れる件数は、時間によって違うようです。夜やったら、 300件位可能でしたが、昼は 200件位した取れませんでした。

逃げの方法ですが、このプログラムはB2で最初の位置を指定できます。シートをいくつか用意して、まず
B2　0
C2　300
にして実行。時間がたってから、
B2　300
C2　300
にして実行する。今のところこれしかは方法はありません。

ストッパー付きのプログラムは作ったのですか、このエラーが解決しない限り、プログラムを載せても無駄なので載せません。今、対策を考えているので、ここは閉じずにおいていてください。

お礼

こんんちは、再びのご回答ありがとうございます！
勝手な判断とは…なんと恐れ多い事をおっしゃいますか。

インターバルを入れるだけでは、解決出来ないのですね。悩ましい。

ちなみに50件を3回連続でも、3回目にはErrorが返ってきました。
少ない数でも、連続で行うとだめでした。

とても勉強になります！
ありがとうございます。
お待ちしています。