运行时错误91与VBA Web抓取不时

Question

我遇到了this post。我尝试了接受的答案建议的解决方案，并提出了以下代码。

Sub WebScraping()

Dim appIE As Object
Dim myValue As String
Dim iLastRow As Integer
Dim allRowOfData

Application.DisplayAlerts = False

Set appIE = CreateObject("internetexplorer.application")

With appIE
    .Navigate "http://uk.investing.com/rates-bonds/financial-futures"
    .Visible = False
End With

Do While appIE.Busy
    DoEvents
Loop

'Set allRowOfData = appIE.document.getElementById("pair_8907")

Worksheets("Web Scraping").Activate

'myValue = allRowOfData.Cells(7).innerHTML
myValue = appIE.document.getElementById("pair_8907").Cells(7).innerHTML

iLastRow = ActiveSheet.Range("B100000").End(xlUp).Row
ActiveSheet.Cells(iLastRow, 1).Select

If iLastRow = 1 Then
    ActiveCell.Offset(1, 0).Value = "US 30Y T-Bond"
    ActiveCell.Offset(1, 1).Value = myValue
    ActiveCell.Offset(1, 2).Value = Now()
    ActiveCell.Offset(1, 2).Select
ElseIf iLastRow > 1 Then
    ActiveCell.Copy Destination:=Cells(ActiveCell.Row + 1, 1)
    ActiveCell.Offset(1, 1).Value = myValue
    ActiveCell.Offset(1, 2).Value = Now()
    ActiveCell.Offset(1, 2).Select
End If

appIE.Quit
Set appIE = Nothing
Set allRowOfData = Nothing

End Sub

我的脚本在10次中有9次顺利运行，但有时会抛出错误：

当发生这种情况时，VBE调试器显示命令停止

myValue = appIE.document.getElementById("pair_8907").Cells(7).innerHTML

Answer 1

我认为你没有足够的时间来装载...所以有这个功能WaitIE等待页面加载，它设置为5000毫秒，如果错误继续，你可以给更多的时间。

#If VBA7 Then  
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems  
#Else  
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds as Long) 'For 32 Bit Systems  
#End If 

Sub WebScraping()

Dim appIE As Object
Dim myValue As String
Dim iLastRow As Integer
Dim allRowOfData

Application.DisplayAlerts = False

Set appIE = CreateObject("internetexplorer.application")

With appIE
    .Navigate "http://uk.investing.com/rates-bonds/financial-futures"
    .Visible = False
End With

   WaitIE appIE, 5000

'Set allRowOfData = appIE.document.getElementById("pair_8907")

Worksheets("Web Scraping").Activate

'myValue = allRowOfData.Cells(7).innerHTML
myValue = appIE.document.getElementById("pair_8907").Cells(7).innerHTML

iLastRow = ActiveSheet.Range("B100000").End(xlUp).Row
ActiveSheet.Cells(iLastRow, 1).Select

If iLastRow = 1 Then
    ActiveCell.Offset(1, 0).Value = "US 30Y T-Bond"
    ActiveCell.Offset(1, 1).Value = myValue
    ActiveCell.Offset(1, 2).Value = Now()
    ActiveCell.Offset(1, 2).Select
ElseIf iLastRow > 1 Then
    ActiveCell.Copy Destination:=Cells(ActiveCell.Row + 1, 1)
    ActiveCell.Offset(1, 1).Value = myValue
    ActiveCell.Offset(1, 2).Value = Now()
    ActiveCell.Offset(1, 2).Select
End If

appIE.Quit
Set appIE = Nothing
Set allRowOfData = Nothing

End Sub

Sub WaitIE(IE As Object, Optional time As Long = 250)
'Code from: https://stackoverflow.com/questions/33808000/run-time-error-91-object-variable-or-with-block-variable-not-set
Dim i As Long
Do
    Sleep time
    Debug.Print CStr(i) & vbTab & "Ready: " & CStr(IE.READYSTATE = 4) & _
                vbCrLf & vbTab & "Busy: " & CStr(IE.Busy)
    i = i + 1
Loop Until IE.READYSTATE = 4 Or Not IE.Busy
End Sub