试点货运跟踪macros在一台电脑上工作，但不是另一台

最近我们的办公室升级到新的笔记本电脑。 幸运的是，从Windows 7切换到10以及从桌面切换到笔记本电脑，我们没有遇到任何运行此macros的问题，除了需要在Pilotdelivers.com上启用popup窗口。 几个星期以来，我们已经在两台不同的笔记本电脑上运行了这个macros，一切都很顺利。

今天，在其中一台笔记本电脑上，macros不再正常工作，但另一方面它没有问题。 我检查，以确保popup式窗口被启用，并且两台计算机都运行在我们的networking上的同一个Excel工作表。 我重新启动计算机两次，运行macros，没有其他应用程序打开。 笔记本电脑是同一个型号，同时安装。 相同的软件安装和更新。 有麻烦的笔记本电脑是由我不太懂计算机的同事和正在工作的笔记本电脑使用的。 所以有可能他改变了他不应该做的一些设置，但我不知道要检查什么。

它似乎跳过点击链接打开一个新标签的代码部分。

macros应该做什么：

1. 在工作表上复制跟踪号码
2. 打开IE
3. 将跟踪号码插入文本框中
4. 点击轨道
5. 等待新的页面加载
6. 点击跟踪号码链接
7. 等待新标签加载
8. closures第一个标签
9. 检查最近的更新是否已经交付
10. 如果是的话，它会切换回Excel并inputDELIVERED和交货date，如果没有，它会查看最新的更新并将该行添加到工作表中。

macros看起来像在做什么：

1. 在工作表上复制跟踪号码
2. 打开IE
3. 将跟踪号码插入文本框中
4. 点击轨道
5. 等待新的页面加载
6. 似乎跳过点击跟踪号码链接
7. 等待当前页面加载（已经加载）
8. 当寻找最新的更新时，它会抓取跟踪号码（因为它不是预期的页面）
9. 检查是否标记为DELIVEED 10.如果是，则切换回excel并inputDELIVERED和交付date，如果不是，则查看最近的更新并将该行添加到工作表

它似乎是跳过部分或全部的代码部分：

Dim ieDOC As HTMLDocument Set ieDOC = ie.document Set htmlColl = ieDOC.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 

下面的完整代码：

 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 Dim marker As Integer RowCount = 0 ProURL = "http://www.pilotdelivers.com/" Do While Not ActiveCell.Offset(RowCount, -5).Value = "" Set ie = CreateObject("InternetExplorer.application") With ie .Visible = True .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 Dim ieDOC As HTMLDocument Set ieDOC = ie.document Set htmlColl = ieDOC.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 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 If ActiveCell.Offset(RowCount).Value <> "DELIVERED" Then ActiveCell.Offset(RowCount, -2).Value = "" Else ActiveCell.Offset(RowCount, -2).Value = htmlInput2.innerText End If 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 

Answer 1

而不是这个：

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

你应该能够做到这一点：

  ieDOC.getElementById("clickElement").Click 

Id在给定的页面中应该是唯一的。 我看到你在其他地方使用了getElementById ，那么有什么原因没有在这里使用？

我猜也许问题是这样的：

 ie.Quit 

所以请试着评论一下。 什么可能做什么新页面加载（新窗口VS新标签？）

如果您在抓取正确的IE文档时遇到问题，请尝试如下所示：

 Function GetIE(sLocation As String) As Object Dim objShell As Object, objShellWindows As Object, o As Object Dim sURL As String Dim retVal As Object Set retVal = Nothing Set objShell = CreateObject("Shell.Application") Set objShellWindows = objShell.Windows For Each o In objShellWindows sURL = "" On Error Resume Next 'check the URL and if it's the one you want then ' assign it to the return value and exit the loop sURL = o.document.Location On Error GoTo 0 If sURL Like sLocation & "*" Then Set retVal = o Exit For End If Next o Set GetIE = retVal End Function 

这个函数将会返回一个与提供的URL相匹配的IE窗口（也就是URL的第一个string是传入的sLocationstring）