运行-使用VBA抓取在线数据时出现时间错误'-2147467259 (80004005)

Question

我创建了在线收集单词列表翻译的代码。当我在单个条目上测试它时它工作正常，当我添加一个循环时它也适用于 23 个条目。但是随后，后续的翻译开始变得空洞，最终我得到了这个运行-time 错误：

Run-time error '-2147467259 (80004005)

出现在行

IE.navigate "http://www.yellowbridge.com/chinese/dictionary.php?word=" & EnglishTrans.Offset(0, 8).Value

在我对运行代码的一些尝试中也出现了一些其他错误——不幸的是我没有把它们写下来。我做错了什么，我该如何解决？

截图

 Private Sub GetTranslation()

Dim EnglishTrans As Range
Dim doc As HTMLDocument
Dim Translation1 As String
Dim Translation2 As String
Dim Translation3 As String
Dim Translation4 As String
Dim Translation5 As String
Dim Translation6 As String
Dim IE As New internetExplorer

Set EnglishTrans = Range("d24")

Do Until EnglishTrans.Offset(0, 8) = ""

IE.navigate "http://www.yellowbridge.com/chinese/dictionary.php?word=" & EnglishTrans.Offset(0, 8).Value

Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE

Set doc = IE.document

On Error GoTo ErrHand

Translation1 = Trim(doc.getElementsByTagName("td")(2).innerText)
Translation2 = Trim(doc.getElementsByTagName("td")(5).innerText)
Translation3 = Trim(doc.getElementsByTagName("td")(8).innerText)
Translation4 = Trim(doc.getElementsByTagName("td")(11).innerText)
Translation5 = Trim(doc.getElementsByTagName("td")(14).innerText)
Translation6 = Trim(doc.getElementsByTagName("td")(1).innerText)

If Translation1 = "Traditional Script" Then
    EnglishTrans.Value = Translation6
Else
    EnglishTrans.Value = Translation1 & "|" & Translation2 & "|" & Translation3 & "|" & Translation4 & "|" & Translation5
End If

Set EnglishTrans = EnglishTrans.Offset(1, 0)

Loop

Exit Sub
ErrHand:
    If Err.Number = 91 Then Resume Next
End Sub

Answer 1

我最终找到了一个不错的解决方法。问题似乎是太多的 Internet Explorer 实例运行。所以我创建了一个杀死所有 IE 实例的子程序：

Sub Kill_IE()

Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1

wsh.Run "taskkill /F /IM iexplore.exe", windowStyle, waitOnReturn

End Sub

我每 29 个条目调用一次该子程序（由于未知原因，该问题现在出现的频率略有降低），这几乎解决了问题——可能不是理想的解决方案，但我可以设置它并忘记它。我对 IE.Quit 和 Set IE = Nothing 没有任何运气，我看到有人建议解决这个问题；它似乎根本没有缓解问题——尽管这肯定是由于实施不力造成的。其他更改，例如添加子“SetPrefTrad”，与此问题无关。 SetPrefTrad sub 只是在那里将字符集首选项更改为繁体 - Yellowbridge.com 默认情况下将所有字符转换为简体。

Sub GetTranslation()

Dim IE As New internetExplorer
Dim doc As HTMLDocument
Dim EnglishTrans As Range
Dim Translation1 As String
Dim Translation2 As String
Dim Translation3 As String
Dim Translation4 As String
Dim Translation5 As String
Dim Translation6 As String
Dim i As Integer

Set EnglishTrans = Range("d2")


Call SetPrefTrad
i = 1


Do Until EnglishTrans.Offset(0, 8) = ""
If i = 30 Then
    Call Kill_IE
    i = 1
End If


IE.navigate "http://www.yellowbridge.com/chinese/dictionary.php?word=" & EnglishTrans.Offset(0, 8).Value

Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE

Set doc = IE.document

On Error GoTo ErrHand

Translation1 = Trim(doc.getElementsByTagName("td")(2).innerText)
Translation2 = Trim(doc.getElementsByTagName("td")(5).innerText)
Translation3 = Trim(doc.getElementsByTagName("td")(8).innerText)
Translation4 = Trim(doc.getElementsByTagName("td")(11).innerText)
Translation5 = Trim(doc.getElementsByTagName("td")(14).innerText)
Translation6 = Trim(doc.getElementsByTagName("td")(1).innerText)

If Translation1 = "Simplified Script" Or Translation1 = "See also" Then
    EnglishTrans.Value = Translation6
Else
    EnglishTrans.Value = Translation1 & "|" & Translation2 & "|" & Translation3 & "|" & Translation4 & "|" & Translation5
End If

Set EnglishTrans = EnglishTrans.Offset(1, 0)
i = i + 1

IE.Quit
Set IE = Nothing

Loop

Exit Sub

ErrHand:
    If Err.Number = 91 Then Resume Next

End Sub

Sub SetPrefTrad()

Dim IE As New internetExplorer

IE.navigate "http://www.yellowbridge.com/chinese/dictionary-prefs.php?returnTo=%2Fchinese%2Fdictionary.php%3Fword%3D%25E5%2584%25AA"
IE.Visible = True

Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE

Dim TradSimpOpt As Object

Set TradSimpOpt = IE.document.getElementById("characterMode")
TradSimpOpt.selectedIndex = "t"

Dim objInputs As Object
Dim ele As Object

Set objInputs = IE.document.getElementsByTagName("input")

For Each ele In objInputs
    If ele.Value Like "Save" Then
        ele.Click
    End If
Next

Do
DoEvents
Loop Until IE.readyState = READYSTATE_COMPLETE

End Sub

Sub Kill_IE()

Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1

wsh.Run "taskkill /F /IM iexplore.exe", windowStyle, waitOnReturn

Call SetPrefTrad

End Sub

运行-使用VBA抓取在线数据时出现时间错误'-2147467259 (80004005)

Run-time error '-2147467259 (80004005) when scraping online data with VBA

vba

runtime-error

web-scraping