【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
お礼
詳しく説明していただいてありがとうございます！！ ms以下も設定できるんですね。 いろいろためになりました。