使用VBA

Question

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

  

运行时错误'-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子用于将字符集首选项更改为传统--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