Question

我目前正在尝试创建一张能够提取发送包裹的跟踪信息的工作表。我暂时制定了以下代码，但遇到了以下问题：

代码在页面完全加载之前继续，我怀疑这可能是因为在初始加载完成后，它会运行一个脚本并刷新。

如果鼠标没有在Internet Explorer上滚动，则很有可能通过图像进行人工验证。我理解这可能无法避免，但有人可以在有人完成验证时暂停脚本吗？

Sub RoyalTrack()

    Dim i As Long
    Dim ie As Object
    Dim t As String

    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Visible = True
        .Navigate "https://www.royalmail.com/track-your-item#/tracking-results/SF511991733GB"
        .Resizable = True
    End With

    While ie.ReadyState <> 4 Or ie.Busy: DoEvents: Wend

    Dim full As Variant
    Dim latest As Variant

    full = ie.Document.getElementsByClassName("c-tracking-history")(0).innerText
    latest = ie.Document.getElementsByClassName("tracking-history-item ng-scope")(0).innerText

    MsgBox full
    MsgBox latest

End Sub

Answer 1

管理解决问题。在页面加载后添加了2秒等待以允许加载，并在错误处理程序中添加以确定所需属性是否可用。

Sub RoyalTrack()


Dim i As Long
Dim ie As Object
Dim t As String
Dim trackingN As String
Dim count As Integer
count = 2

Do While Worksheets("Sheet1").Range("D" & count).Value <> ""

Set ie = CreateObject("InternetExplorer.Application")
trackingN = Worksheets("Sheet1").Range("D" & count).Value
    With ie
    .Visible = True
  ' Variable tracking SF-GB
    .Navigate "https://www.royalmail.com/track-your-item#/tracking-results/" & trackingN
    .resizable = True
End With

While ie.readyState <> 4 Or ie.Busy: DoEvents: Wend

Application.Wait (Now + TimeValue("0:00:02"))

Dim full As Variant
Dim latest As Variant

On Error Resume Next
latest = ie.document.getElementsByClassName("tracking-history-item ng-scope")(0).innerText

If Err Then
    MsgBox "Prove your humanity if you can"
    Err.Clear
End If

latest = ie.document.getElementsByClassName("tracking-history-item ng-scope")(0).innerText

Windows("Book1.xls").Activate
Sheets("Sheet1").Select

Range("E" & count).Value = latest

ie.Quit
Set ie = Nothing
count = count + 1

Loop

End Sub

暂停脚本直到网站完全加载 - Excel VBA

1 个答案: