网页抓取

Question

到目前为止，我正试图从www.ups.com获得许多数字的跟踪结果，通过使用F8对VBA进行解释，我得到了非常好的结果。但是，在使用F5运行完整集的代码时，它会给我一个运行时错误。

我想知道包裹的日期和寄存在哪里。

参考跟踪号

1Z5X10F70364459911
1Z5X10F79065556123
1Z5X10F70364649537
1Z5X10F79064044142
1Z5X10F70365323958
1Z5X10F79066952961
1Z5X10F70364875177
1Z5X10F79065114583
1Z5X10F70366375196

这是我的代码：

Sub Test2()
Dim Tnx As String
Dim lastrow As Integer
Dim IE As New InternetExplorer
Dim data As String
Dim Doc As HTMLDocument

'For selection last row with count
lastrow = Sheet1.Cells(Rows.Count, "C").End(xlUp).Row

IE.Visible = False
IE.navigate "www.ups.com"

Do While IE.readyState <> READYSTATE_COMPLETE
Loop

For i = 2 To lastrow
    Tnx = Sheet1.Cells(i, 3).Value

    IE.document.getElementById("ups-track--qs").Value = Tnx
    IE.document.getElementById("ups-tracking-submit").Click

    Do While IE.readyState <> READYSTATE_COMPLETE
    Loop
    Set Doc = IE.document

    data = IE.document.getElementsByClassName("ups-form_label")(1).innerText
    Sheet1.Cells(i, 4).Value = data

Next

End Sub

Answer 1

这个对你有用吗？

Do Until data <> ""
    On Error Resume Next
    data = IE.document.getElementsByClassName("ups-form_label")(1).innerText
    On Error GoTo 0
    DoEvents
Loop
Sheet1.Cells(i, 4).Value = data

Answer 2

所以这有点烦人但很有效。

1)解析

Option Explicit

Sub ExtractDeliveryDetails()

    Dim Tnx As String, lastrow As Long, i As Long, ie As New InternetExplorer

    With ThisWorkbook.Worksheets("Sheet1")

        lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row

        ie.Visible = True
        ie.navigate "www.ups.com"

        Do While ie.Busy = True Or ie.readyState <> 4: DoEvents: Loop

        For i = 2 To lastrow
            Tnx = .Cells(i, 3).Value
            ie.document.getElementById("ups-track--qs").Value = Tnx
            ie.document.getElementById("ups-tracking-submit").Click

            Do While ie.Busy = True Or ie.readyState <> 4: DoEvents: Loop
            Application.Wait Now + TimeSerial(0, 0, 3)
            ie.document.getElementById("trackNums").Value = Tnx

            Dim buttons As Object
            Set buttons = ie.document.getElementsByTagName("button")

            Dim btn As Object
            For Each btn In buttons
                If InStr(btn.Value, "Track") > 0 Then
                    btn.Click
                    Exit For
                End If
            Next btn

            Do While ie.Busy = True Or ie.readyState <> 4: DoEvents: Loop
            Application.Wait Now + TimeSerial(0, 0, 2) '<==alter timings or loop until a value can be set

            Dim htmlArray() As String
            htmlArray = Split(ie.document.body.innerHTML, "ups-form_label")

            .Cells(i, 4) = Trim$(Replace$(Replace$(Split(Replace(Split(htmlArray(1), "<p>")(1), "&nbsp;", vbNullString), "</p>")(0), Chr(10), vbNullString), vbTab, " "))
            .Cells(i, 5) = Trim$(Replace$(Replace$(Split(Replace(Split(htmlArray(2), "<p>")(1), "&nbsp;", vbNullString), "</p>")(0), Chr(10), vbNullString), vbTab, " "))

        Next i

    End With

End Sub

2)使用querySelectorAll来匹配CSS

您还可以在最后使用querySelectorAll，而不是解析HTML，如下所示：

Dim b As Object 'DispStaticNodeList
Set b = ie.document.querySelectorAll(".ups-form_label ~ p")

Dim dropDate As String, dropLocation As String

dropDate = b.item(0).innerText
dropLocation = b.item(1).innerText
.Cells(i, 4) = dropDate
.Cells(i, 5) = dropLocation

这具有更强的鲁棒性，因为您可以循环NodeList的长度，使用b.Length测试所需属性的内容。

注：

您可以更好地将Waits重写为Loop Until对象(例如，设置了ie.document.getElementById("trackNums")，即在视图中设置了一个指定的超时，以防止永循环的潜在可能性。

示例输出：

​

​

有趣的NodeList参考：

1. NodeList