Соскоб веб-страницы

Question

Я пытаюсь получить результат отслеживания для большого числа номеров с www.ups.com До сих пор мне удавалось добиться превосходного результата, превзойдя VBA с помощью F8. Тем не менее, это дает мне ошибку во время выполнения при использовании 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) Разбор HTML

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

Answer 3

Для начала нужно следовать инструкциям на сайте. Вы используете неправильный URL для своей страны:

https://www.ups.com/WebTracking/track?loc=en_IN

Во-вторых, если «все, что я хочу в этом проекте, это отслеживать некоторые пакеты автоматически», то почему бы просто не сделать это так же, как все остальные?

Сайт создан для отслеживания нескольких пакетов и автоматической отправки вам обновлений и т. Д. Это ИБП, вот что они делают.

Без знания VBA это не очень хороший стартовый проект, и этот сайт не предназначен для обучения начинающих основам кодирования. Пожалуйста, обратитесь в Справочный центр .