錯誤438不支持屬性或方法，代碼幾分鐘前工作

Question

所以我有這段代碼工作幾分鐘前，除了第二個ie加載的標籤不會關閉。所以我繞了一圈，我想我打破了。我不認爲我改變了任何與那些拋出錯誤的代碼行有關的任何事情，但我可能只是想念它。如果您需要，完整的代碼會降低。以下是我認爲這是相關代碼：

Dim ie As Object 
Dim RowCount As Integer 
Dim i As Integer 
Dim shellWins As ShellWindows 
Dim htmlColl2 As MSHTML.IHTMLElementCollection 
Dim htmlInput2 As MSHTML.HTMLInputElement 

'The code edited out navigates to pilot.com, enters a tracking number, clicks the submit button, brings up a new page with minimal tracking information and clicks a link to load up a new tab with detailed tracking information. 

ie.Quit 
'it seems I have to close out of the first tab to be able to focus excel on the new one 

Set shellWins = New ShellWindows 
If shellWins.Count > 0 Then 
    Set ie2 = shellWins.Item(1) 
    'this finds the new tab 
End If 

Do Until Not ie2.Busy And ie2.readyState = 4: DoEvents: Loop 
     'every so often this will throw an error as well but I don't remember what the error was. 

Set htmlColl2 = ie2.document.getElementsByTagName("td") 
      'The above line causes Runtime error 438 - object doesn't support this property or method. 
For Each htmlInput2 In htmlColl2 
    If htmlInput2.className = "dxgv" Then 
     If ActiveCell.Offset(RowCount).Value = "" Then 
      ActiveCell.Offset(RowCount).Value = htmlInput2.innerText 
      'this puts the status of the shipment in a cell 
     Else 
      ActiveCell.OffSet(RowCount, 1).Value = htmlInput2.innerText 
      'this puts the date of that satus in the next cell 
      Exit For 
     End If 
    End If 
Next htmlInput2 

ie2.Quit 
    'This does not close out of the new tab like I'd expect it too and I haven't solved that yet either.* 


Set shellWins = Nothing 
Set ie2 = Nothing 

下面的代碼是我當前的代碼全長：

Sub WaitHalfSec() 
    Dim t As Single 
    t = Timer + 1/2 
     Do Until t < Timer: DoEvents: Loop 
End Sub 

Sub PilotTracking() 
Dim ProURL As String 
Dim ie As Object 
Dim RowCount As Integer 
Dim i As Integer 
Dim html_Document As HTMLDocument 
Dim htmlColl As MSHTML.IHTMLElementCollection 
Dim htmlInput As MSHTML.HTMLInputElement 
Dim shellWins As ShellWindows 
Dim htmlColl2 As MSHTML.IHTMLElementCollection 
Dim htmlInput2 As MSHTML.HTMLInputElement 

Set ie = CreateObject("InternetExplorer.application") 
RowCount = 0 
ProURL = "http://www.pilotdelivers.com/" 

Do While Not ActiveCell.Offset(RowCount, -5).Value = "" 

With ie 
    .Visible = False 
    .navigate ProURL 
    Do Until Not ie.Busy And ie.readyState = 4: DoEvents: Loop 
End With 

Set Doc = ie.document 'works don't delete 

Doc.getElementById("tbShipNum").innerHTML = ActiveCell.Offset(RowCount, -5).Value 'works don't delete 

Doc.getElementById("btnTrack").Click 'works don't delete 

Do Until Not ie.Busy And ie.readyState = 4: DoEvents: Loop 

i = 0 
Do While i < 4 
    WaitHalfSec 
    i = i + 1 
Loop 

Do Until Not ie.Busy And ie.readyState = 4: DoEvents: Loop 

Set htmlColl = ie.document.getElementsByTagName("a") 
For Each htmlInput In htmlColl 
    If htmlInput.ID = "clickElement" Then 
     htmlInput.Click 
    Exit For 
    End If 
Next htmlInput 

ie.Quit 

Set shellWins = New ShellWindows 
If shellWins.Count > 0 Then 
    Set ie2 = shellWins.Item(1) 
End If 

i = 0 
Do While i < 6 
    WaitHalfSec 
    i = i + 1 
Loop 

Do Until Not ie2.Busy And ie2.readyState = 4: DoEvents: Loop 
     'every so often this will throw an error as well but I don't remember what the error was. 

Set htmlColl2 = ie2.document.getElementsByTagName("td") 
      'The above line causes Runtime error 438 - object doesn't support this property or method. 
For Each htmlInput2 In htmlColl2 
    If htmlInput2.className = "dxgv" Then 
     If ActiveCell.Offset(RowCount).Value = "" Then 
      ActiveCell.Offset(RowCount).Value = htmlInput2.innerText 
     Else 
      ActiveCell.OffSet(RowCount, 1).Value = htmlInput2.innerText 
      Exit For 
     End If 
    End If 
Next htmlInput2 

ie2.Quit 
    'This does not close out of the new tab like I'd expect it too and I haven't solved that yet either.* 

RowCount = RowCount + 1 

Loop 

Set shellWins = Nothing 
Set ie = Nothing 
Set ie2 = Nothing 

End Sub 

Sub WaitHalfSec() 
    Dim t As Single 
    t = Timer + 1/2 
     Do Until t < Timer: DoEvents: Loop 
End Sub 

Answer 1

我能得到它的工作。對於任何尋求幫助的人，我的工作代碼如下所示。

Sub PilotTracking() 
Dim ProURL As String 
Dim ie As Object 
Dim ie2 As Object 
Dim RowCount As Integer 
Dim i As Integer 
Dim html_Document As HTMLDocument 
Dim htmlColl As MSHTML.IHTMLElementCollection 
Dim htmlInput As MSHTML.HTMLInputElement 
Dim shellWins As ShellWindows 
Dim htmlColl2 As MSHTML.IHTMLElementCollection 
Dim htmlInput2 As MSHTML.HTMLInputElement 

RowCount = 0 
ProURL = "http://www.pilotdelivers.com/" 

Do While Not ActiveCell.Offset(RowCount, -5).Value = "" 

Set ie = CreateObject("InternetExplorer.application") 

With ie 
    .Visible = False 
     'threw automation error on the second loop, before moving set ie = nothing group 
     'after moving set ie = nothing withing the loop this threw error 91, object or with 
      'block variable not set. Moved set ie = create object within the loop 
     'stopped throwing errors 
    .navigate ProURL 
    Do Until Not ie.Busy And ie.readyState = 4: DoEvents: Loop 
End With 

Set Doc = ie.document 'works don't delete 

Doc.getElementById("tbShipNum").innerHTML = ActiveCell.Offset(RowCount, -5).Value 'works don't delete 

Doc.getElementById("btnTrack").Click 'works don't delete 

Do Until Not ie.Busy And ie.readyState = 4: DoEvents: Loop 

i = 0 
Do While i < 4 
    WaitHalfSec 
    i = i + 1 
Loop 

Do Until Not ie.Busy And ie.readyState = 4: DoEvents: Loop 

Set htmlColl = ie.document.getElementsByTagName("a") 
For Each htmlInput In htmlColl 
    If htmlInput.ID = "clickElement" Then 
     htmlInput.Click 
    Exit For 
    End If 
Next htmlInput 

ie.Quit 

Set shellWins = New ShellWindows 
If shellWins.Count > 0 Then 
    Set ie2 = shellWins.Item(1) 
End If 

i = 0 
Do While i < 8 
    WaitHalfSec 
    i = i + 1 
Loop 

Do Until Not ie2.Busy And ie2.readyState = 4: DoEvents: Loop 
    'Threw error 91 obj var or with block var not set 
    'Didn't change anything, ran a couple times fine then errored again 
     'changed above do while from i6 to i8 

Set htmlColl2 = ie2.document.getElementsByTagName("td") 
For Each htmlInput2 In htmlColl2 
    If htmlInput2.className = "dxgv" Then 
     If ActiveCell.Offset(RowCount).Value = "" Then 
      ActiveCell.Offset(RowCount).Value = htmlInput2.innerText 
     Else 
      ActiveCell.Offset(RowCount, 1).Value = htmlInput2.innerText 
      Exit For 
     End If 
    End If 
Next htmlInput2 

ie2.Quit 
Set shellWins = Nothing 
Set ie = Nothing 
Set ie2 = Nothing 

RowCount = RowCount + 1 

Loop 

Set shellWins = Nothing 
Set ie = Nothing 
Set ie2 = Nothing 

End Sub 

Sub WaitHalfSec() 
    Dim t As Single 
    t = Timer + 1/2 
     Do Until t < Timer: DoEvents: Loop 
End Sub