Question

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

今天，在其中一台笔记本电脑上，宏不再正常工作，但另一方面它很好。我检查确保弹出窗口已启用，并且两台计算机都在我们网络上的同一个excel工作表中运行。我重新启动计算机两次并运行宏而没有打开其他应用程序。笔记本电脑是同一型号，同时安装。相同的软件安装和更新。有问题的笔记本电脑被我精通计算机的同事和使用的笔记本电脑所使用。所以他可能会改变一些他不应该改变的设置，但我不确定要检查什么。

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

宏应该做什么：

复制工作表上的跟踪号
打开IE
将跟踪号插入文本框
点击跟踪
等待新页面加载
点击跟踪号码链接
等待新标签加载
关闭第一个标签
检查最近的更新是否已交付
如果是，则切换回excel并输入DELIVERED和交货日期，如果没有，它会查看最新的更新并添加那条线到工作表。

宏似乎在做什么：

复制工作表上的跟踪号
打开IE
将跟踪号插入文本框
点击跟踪
等待新页面加载
似乎跳过点击跟踪号码链接
等待当前页面加载（已加载）
在查找最新更新时，它会抓取跟踪号码相反（因为它不是预期的页面）
检查它是否标记为已交付 10.如果是，它切换回excel并输入DELIVERED和交货日期，如果没有，它会查看最新的更新并添加该行到工作表

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

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

所以试着评论一下。或许还有新页面加载的地方（新窗口与新标签？）

如果您在抓取正确的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

此函数将返回一个IE窗口，该窗口与提供的URL匹配（即URL的第一个以传递的sLocation字符串开头）

试点货运跟踪宏在一台计算机上工作，但没有另一台

1 个答案: