こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

【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

投稿日時 - 2018-01-24 17:09:43

QNo.9421818

すぐに回答ほしいです

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.5

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

投稿日時 - 2018-02-01 04:42:50

ANo.4

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

投稿日時 - 2018-01-31 04:07:07

ANo.3

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

投稿日時 - 2018-01-29 22:41:18

補足

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

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

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

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

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

投稿日時 - 2018-01-30 11:28:19

ANo.2

 勝手な判断とは…私が 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 URL
B10 説明
 リングは検索結果以外にもいろいろあります。このようなプログラムを作る時は、必要な物をどうやって見分けるか悩みます。検索結果には太字が使われているので、<b> のあるリンクは必要と判断しています。
 B5はTrueにするとIEが表示され、すぐに消えます。面白いけれどうざいです。1にすると1ページ処理する度に止まります。デバッグのための機能です。
'
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に使えます。単なる遊びですが。

投稿日時 - 2018-01-26 23:24:11

補足

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

投稿日時 - 2018-01-29 11:53:49

ANo.1

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

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

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

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

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

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

投稿日時 - 2018-01-26 08:16:11

お礼

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

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

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

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

投稿日時 - 2018-01-26 14:43:17

あなたにオススメの質問