错误 438 不支持 属性 或方法，代码在几分钟前工作
Error 438 Doesn't support property or method, code was working a few minutes ago
所以我在几分钟前让这段代码工作，除了加载的第二个 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
我能够让它工作。对于寻求帮助的任何人，我的工作代码如下所示。
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
所以我在几分钟前让这段代码工作，除了加载的第二个 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
我能够让它工作。对于寻求帮助的任何人，我的工作代码如下所示。
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