所以我遇到了一个轻微的绊脚石,希望有人可以帮助我。简而言之,我需要访问一串网页(每个页面上的名称列表已经输入,该代码工作正常)。当我的代码访问每个页面时,我需要撤回信息。不幸的是,这是一个问题 - 它甚至无法通过" A"我得到之前的列表"自动化错误未指定错误"而且它永远不会在同一个地方。
我已经尝试过"正常"解决这个问题的步骤。我已经安装了VB 6控件,并且我已经注册并重新注册了mscomctl.ocx,包括On Error Resume Next(它没有做任何事情)。
它通常会在它死亡之前达到100多个病例(如我前面所说的那样随机)。弹出错误后,当我尝试重新运行它时(有或没有更改),并在第一个时出现错误。如果我重新启动计算机,它会让我再试一次(无论出于何种原因),但它仍然没有完成。
代码是否过于复杂,我需要减少它?我可以找到一种方法,让它一次只运行每个字母(运行所有A' s,然后执行B'等)但我仍然无法完成它字母A.
我注意到在另一个线程中有人建议而不是使用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
答案 0 :(得分:1)
我注意到的一件事是你不断在循环中创建新的IE对象,而且你永远不会破坏它们或设置为Nothing
。创建100多个IE实例是毫无意义,昂贵且可能是错误的来源。
我认为最初创建单个IE实例可能会有所帮助,然后在循环中使用相同的对象来导航所需的URL。
所以不要这样:
Dim IE As Variant
Set IE = CreateObject("InternetExplorer.Application")
这样做:
Dim IE as Object
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")