Изменить код, чтобы получить дополнительные данные с сайта

Question

Я получаю данные с веб-сайта, но мне нужна помощь, чтобы вытащить всю строку.

Пример:

Я пытался заглянуть на сайтисходный код, чтобы понять это, но с различными изменениями дают плохие результаты

Option Explicit

Public Sub GetInfo()
    Dim html As HTMLDocument, csrft As String, lastRow As Long, sourceValues() '<  VBE > Tools > References > Microsoft HTML Object Library
    Set html = New HTMLDocument
    Dim ws As Worksheet, i As Long
    Set ws = ThisWorkbook.Worksheets("Sheet4")
    lastRow = ws.Cells(ws.rows.Count, "B").End(xlUp).Row
    sourceValues = ws.Range("B2:D" & lastRow).Value
    Dim results()
    ReDim results(1 To UBound(sourceValues, 1), 1 To 4)
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.partstown.com", False
        .send
        html.body.innerHTML = .responseText

        csrft = html.querySelector("[name=CSRFToken]").Value
        Stop
        For i = LBound(sourceValues, 1) To UBound(sourceValues, 1)
            If sourceValues(i, 1) <> vbNullString And sourceValues(i, 3) <> vbNullString Then
                DoEvents
                .Open "POST", "https://www.partstown.com/track-my-order", False
                .setRequestHeader "Referer", "https://www.partstown.com/track-my-order"
                .setRequestHeader "User-Agent", "Mozilla/5.0"
                .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
                .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8"
                .setRequestHeader "Accept-Encoding", "gzip, deflate"
                .setRequestHeader "Accept-Language", "en-US,en;q=0.9"
                .send "orderNo=" & sourceValues(i, 1) & "&postalCode=" & sourceValues(i, 3) & "&CSRFToken=" & csrft

                html.body.innerHTML = .responseText

                Dim shipping As String, order As String, items() As String

                shipping = html.querySelector("[data-label=Shipping]").innerText
                order = html.querySelector(".order-history__item-descript--min").innerText
                items = Split(order, vbNewLine)

                Dim qtyOrdered As Long, qtyShipped As String, product As String

                qtyOrdered = CLng(Replace$(items(0), "Qty Ordered: ", vbNullString))
                qtyShipped = CLng(Replace$(items(1), "Qty Shipped: ", vbNullString))
                product = html.querySelector(".details-table a").Title

                results(i, 1) = shipping
                results(i, 2) = qtyOrdered
                results(i, 3) = qtyShipped
                results(i, 4) = product
            End If
            'Application.Wait Now + TimeSerial(0, 0, 1)
        Next
    End With
    'results written out from row 2 column E
    ws.Cells(2, 5).Resize(UBound(results, 1), UBound(results, 2)) = results

End Sub

Я ввожу PO и ZIP (4500987740 и 33314), который содержит несколько частей, возвращенные данные являются только первой частью, а не все части,

Пример 2:

Мне нужно вернуть все данные: отслеживание, кол-во заказано, кол-во отправлено, продукт, кол-во заказано, кол-во отправлено, и т. Д. -в основном в виде строки, пока все части не отображаются

Answer 1

Проблема заключается в использовании querySelector. querySelector возвращает только первое совпадение. В данном случае это означает, что вы рассматриваете только первое строка. Требуемая поправка - использовать querySelectorAll для возврата всех совпадений. Затем зациклите эти совпадения, чтобы извлечь информацию о каждой строке.

Кроме того, этот селектор .details-table a должен быть изменен, чтобы возвращать только интересующие элементы, то есть .details-table a[title] - те, которые имеют title атрибут.

Для правильной записи в каждую строку используется вспомогательная функция для поиска следующей свободной строки. Поскольку количество строк заранее неизвестно, нельзя установить массив соответствующего размера для размещения всех результатов - хотя вы могли бы увеличить размер массива с самого начала. Этот последний пункт является поправкой, которую вы можете внести. Вместо этого я зацикливаю записи массивов в пакетном режиме.

Option Explicit
Public Sub GetInfo()
    Dim html As HTMLDocument, csrft As String, ws As Worksheet
    Dim lastRow As Long, wsTarget As Worksheet, j As Long '<  VBE > Tools > References > Microsoft HTML Object Library
    Dim sourceValues()

    Set html = New HTMLDocument
    Set ws = ThisWorkbook.Worksheets("Sheet4")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.rows.Count, "B").End(xlUp).Row
    sourceValues = ws.Range("B2:D" & lastRow).Value

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.partstown.com", False
        .send

        html.body.innerHTML = .responseText

        csrft = html.querySelector("[name=CSRFToken]").Value
        For j = LBound(sourceValues, 1) To UBound(sourceValues, 1)
            If sourceValues(j, 1) <> vbNullString And sourceValues(j, 3) <> vbNullString Then
                DoEvents
                .Open "POST", "https://www.partstown.com/track-my-order", False
                .setRequestHeader "Referer", "https://www.partstown.com/track-my-order"
                .setRequestHeader "User-Agent", "Mozilla/5.0"
                .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
                .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8"
                .setRequestHeader "Accept-Encoding", "gzip, deflate"
                .setRequestHeader "Accept-Language", "en-US,en;q=0.9"
                .send "orderNo=" & sourceValues(j, 1) & "&postalCode=" & sourceValues(j, 3) & "&CSRFToken=" & csrft
                html.body.innerHTML = .responseText

                Dim shipping As String, orders As Object, items() As String

                shipping = html.querySelector("[data-label=Shipping]").innerText
                Set orders = html.querySelectorAll(".order-history__item-descript--min")

                Dim i As Long, c As Long, results(), products As Object
                ReDim results(1 To 1, 1 To 4 * orders.length)
                Dim qtyOrdered As Long, qtyShipped As String, product As String
                Set products = html.querySelectorAll(".details-table a[title]")
                c = 1
                For i = 0 To orders.length - 1
                    items = Split(orders.item(i).innerText, vbNewLine)
                    qtyOrdered = CLng(Replace$(items(0), "Qty Ordered: ", vbNullString))
                    qtyShipped = CLng(Replace$(items(1), "Qty Shipped: ", vbNullString))
                    results(1, c) = shipping
                    results(1, c + 1) = qtyOrdered
                    results(1, c + 2) = qtyShipped
                    results(1, c + 3) = products.item(i).Title
                    c = c + 4
                Next
                wsTarget.Cells(GetLastRow(wsTarget) + 1, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
            End If
        Next
    End With
End Sub
Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
    With ws
        GetLastRow = .Cells(.rows.Count, columnNumber).End(xlUp).Row
    End With
End Function