VBA - Excel - 自动化错误未指定错误

VBA - Excel - Automation Error Unspecified Error

提问by user3814832

So I ran into a slight stumbling block and hopefully here someone can help me. In short, I need to visit a string of webpages (the list of the names on each page are already input, that code works fine). As my code visits each page, I need to pull back information. Unfortunately, there's a problem - it can't even make it through the "A" list before I get "Automation Error Unspecified Error" and it's never at the same spot.

所以我遇到了一个轻微的绊脚石，希望有人可以帮助我。简而言之，我需要访问一串网页（每个页面上的名称列表已经输入，该代码工作正常）。当我的代码访问每个页面时，我需要拉回信息。不幸的是，有一个问题 - 在我收到“自动化错误未指定错误”之前，它甚至无法通过“A”列表，而且它永远不会出现在同一地点。

I've tried the "normal" steps to fix this. I've installed the VB 6 Controls and I've unregistered and re-registered mscomctl.ocx, and including On Error Resume Next (which doesn't do anything).

我已经尝试了“正常”步骤来解决这个问题。我已经安装了 VB 6 控件，并且我已经取消注册并重新注册了 mscomctl.ocx，包括 On Error Resume Next（它不做任何事情）。

It usually reaches over 100 cases before it dies (randomly as I said earlier). And AFTER the error pops up, when I try to re-run it (with or without changes) and it errors on the first one. If I restart my computer it will let me try again (for whatever reason) but it still doesn't finish.

它通常会在死亡之前达到 100 多个案例（正如我之前所说的那样随机）。并且在错误弹出后，当我尝试重新运行它（有或没有更改）时，它在第一个上出错。如果我重新启动计算机，它会让我再试一次（无论出于何种原因），但它仍然没有完成。

Is the code too complex and I need to reduce it? I can probably find a way to make it only run for each letter at a time (run all A's, then do B's, etc) but I still can't even get it to complete the letter A.

代码是否太复杂，我需要减少它吗？我可能可以找到一种方法让它一次只对每个字母运行（运行所有 A，然后执行 B 等），但我什至无法让它完成字母 A。

I noticed in another thread someone had suggested instead of using IE to swap to xmlhttp - is that a fix for this? Is the problem that this script is too long? What exactly am I doing wrong here?

我在另一个线程中注意到有人建议不要使用 IE 来交换到 xmlhttp - 这是解决这个问题的方法吗？是不是这个脚本太长的问题？我到底做错了什么？

Sub Lookup()
Range("AI1").Value = "Unique ID"
Range("AJ1").Value = "Name"
Range("AK1").Value = "Birth Year"
Range("AL1").Value = "Title"
Range("AM1").Value = "State"
Range("AN1").Value = "Position"
Range("AO1").Value = "Country"
Range("AP1").Value = "Appointed"
Range("AQ1").Value = "Credentials"
Range("AR1").Value = "Terminations"
Dim i As Integer
For i = 1 To 26
    If i = 24 Then
        Range("X:X").End(xlUp).Select
        ActiveCell.Value = ""
    Else
    Dim ic As String
    ic = LCase(ConvertToLetter(i))
    Range(ic & "5000").End(xlUp).Select
    Dim J As Integer
    J = ActiveCell.Row
    Dim k As Integer
    For k = 2 To J
        Range(ic & k).Select
        Dim Lookup As String
        Lookup = ActiveCell.Value
        Dim IE As Variant
        Set IE = CreateObject("InternetExplorer.Application")
        IE.Visible = False
        IE.navigate "http://history.state.gov/departmenthistory/people/" & Lookup
        Do
            DoEvents
        Loop Until IE.readyState = READYSTATE_COMPLETE
        Dim Doc As HTMLDocument
        Set Doc = IE.document
        Dim Italics As Integer
        Italics = 0
        Dim EachA As Integer
        For EachA = 64 To 100
            Dim Position As String
            Position = Doc.getElementsByTagName("a")(EachA).innerText
            If Position = "Home" Then
                Exit For
            Else
                Dim NameBY As String
                NameBY = Doc.getElementsByTagName("h2")(1).innerText
                Dim TitleST As String
                TitleST = Doc.getElementsByTagName("p")(1).innerText
                Range("AJ" & "90000").End(xlUp).Offset(1, 0).Select
                ActiveCell.Value = NameBY
                TitleState = Split(TitleST, vbLf)
                ActiveCell.Offset(0, 2).Value = TitleState(0)
                On Error GoTo 1037
                ActiveCell.Offset(0, 3).Value = TitleState(1)
                On Error GoTo 1037
1037
                ActiveCell.Offset(0, 4).Select
                ActiveCell.Value = Position
                Dim EachLi As Integer
                EachLi = EachA - 1
                If Doc.getElementsByTagName("li").Item(EachLi + Italics).innerHTML Like "<em>*" Then
                    Italics = Italics + 1
                Else
                End If
                Dim JobList As String
                JobList = Doc.getElementsByTagName("li")(EachLi + Italics).innerText
                Dim Job() As String
                Job() = Split(JobList, vbLf)
                Dim JCount As Integer
                For JCount = LBound(Job) To UBound(Job)
                    ActiveCell.Offset(0, 1).Select
                    ActiveCell.Value = Job(JCount)
                Next JCount
            End If
        Next EachA
    Next k
End If
Next i
End Sub

回答by David Zemens

One thing I notice is that you're continually creating new IE objects inside the loop, and you're never destroying them or setting to Nothing. It's pointless, expensive, and possibly a source of error to be creating 100+ instances of IE.

我注意到的一件事是您在循环内不断创建新的 IE 对象，并且您永远不会销毁它们或设置为Nothing. 创建 100 多个 IE 实例毫无意义、代价高昂，而且可能是错误的来源。

I think it will probably help to create a single instance of IE initially, and then use that same object inside the loop to navigate the desired URLs.

我认为最初创建 IE 的单个实例可能会有所帮助，然后在循环内使用相同的对象来导航所需的 URL。

So instead of this:

所以而不是这个：

Dim IE As Variant
Set IE = CreateObject("InternetExplorer.Application")

Do this:

做这个：

Dim IE as Object
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")