Копирование данных с веб-сайта в Excel с помощью макроса ... потеряно

Question

Я совершенно новичок в этом, но вот моя сфера.Я запускаю макрос для извлечения данных из бизнес-системы.После того, как эта информация извлечена, я хочу, чтобы макрос занял определенные поля, поместил их в форму веб-сайта, нажал кнопку «Отправить», а затем очистил и вставил результаты некоторых данных обратно в Excel.Все работает, за исключением очистки и вставки обратно в Excel.

Помогите пожалуйста!

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

Sub Track()
Range("B2").Select

'This should call to PT and deliver tracking info

Dim IE As Object
Dim tbl As Object, td As Object



 Set IE = CreateObject("InternetExplorer.Application") 'Set IEapp = 
 InternetExplorer
 IE.Visible = True

      IE.Navigate "https://www.partstown.com/track-my-order"
      With IEapp
          Do
          DoEvents
          Loop Until IE.readyState = 4



'Input PO and zip
 Call IE.Document.getElementById("orderNo").SetAttribute("value", 
 "4500969111")
'ActiveCell.Offset(0, 2).Select
 Call IE.Document.getElementById("postalCode").SetAttribute("value", 
 "37040")
 IE.Document.forms(7).Submit

 Application.Wait Now + TimeValue("00:00:09")

'this is where i am stuck. I know this isnt right but tried to piece it 
 together
 Set elemCollection = IE.Document.getelElementsByTagname("table.account- 
 table details _tc_table_highlighted")

 For t = 0 To (elemCollection.Length - 1)
 For r = 0 To (elemCollection(t).Rows.Length - 1)
    For c = 0 To (elemCollection(t).Rows(r).Cells.Length - 1)
 ThisWorkbook.Worksheets(1).Cells(r + 1, c + 1) = 
 elemCollection(t).Rows.Cells(c).innertext
 Next c
 Next r
 Next t

 End With


 End Sub

Вот что я хочу, чтобы это вытащил: Колонка отгрузки Кол-во, заказанный продукт Кол-во и А для линейного отображения: Отгрузка, Кол-во заказано, Кол-во отгружено, Продукт

Answer 1

Internet Explorer:

Я сделал это немного более многословным, чем обычно, чтобы вы могли видеть каждый шаг.

Ключевые вещи:

1) правильная загрузка страницы ожидает с While .Busy Or .readyState < 4: DoEvents: Wend

2) выбор элементов по идентификатору, где это возможно. # - это селектор идентификаторов css . css селекторы применяются методом querySelector .document и извлекают первый элемент на странице, который соответствует указанному шаблону

3) необходим временной цикл для ожидания результатов

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

5) Я упорядочиваю, согласно вашей спецификации, результаты в массиве и записываю этот массив за один раз.

6) "." является селектором класса в .order-history__item-descript--min, т.е. возвращает первый элемент с class из order-history__item-descript--min

7) [x = y] представляет собой атрибут = селектор значения in [data-label=Shipping], т.е. возвращает первый элемент с атрибутом data-label, имеющим значение Shipping

8) Комбинация .details-table a использует комбинатор потомков , "", чтобы указать, что я хочу a элементы тега, у которых есть родительский класс с классом .details-table

VBA:

Option Explicit

'VBE > Tools > References:
' Microsoft Internet Controls
Public Sub RetrieveInfo()
    Dim ie As InternetExplorer, ele As Object, t As Date
    Const MAX_WAIT_SEC As Long = 5

    Set ie = New InternetExplorer

    With ie
        .Visible = True
        .Navigate2 "https://www.partstown.com/track-my-order"

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

        With .document
            .querySelector("#orderNo").Value = "4500969111"
            .querySelector("#postalCode").Value = "37040"
            .querySelector("#orderLookUpForm").submit  
        End With

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

        Dim shipping As String, order As String, items() As String
        With .document
            t = Timer
            Do
                On Error Resume Next
                Set ele = .querySelector("[data-label=Shipping]")
                On Error GoTo 0
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop While ele Is Nothing

            If ele Is Nothing Then Exit Sub

            shipping = ele.innerText
            order = .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 = .querySelector(".details-table a").Title

            Dim results()
            results = Array(shipping, qtyOrdered, qtyShipped, product)
            ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Resize(1, UBound(results) + 1) = results

        End With
        .Quit
    End With
End Sub

Если вы новичок в HTML, посмотрите:

https://developer.mozilla.org/en-US/docs/Web/HTML

Если вы не знакомы с селекторами CSS, пожалуйста, посмотрите:

https://flukeout.github.io/

---

XMLHTTP:

Все это также можно сделать с помощью XHR . Это намного быстрее, чем открывать браузер.

XHR:

Используйте объекты XMLHttpRequest (XHR) для взаимодействия с серверами. Вы можете извлекать данные из URL, не делая полной страницы [render]

В этом случае я делаю начальный GET запрос на целевую страницу, чтобы получить CSRFToken, чтобы использовать в моей реконструкции запрос POST, который страница отправляет на сервер, когда вы вручную вводите данные и нажимаете кнопку Отправить. Вы получите нужные данные в ответе сервера. Я передаю строку запроса в теле строки отправки POST .send "orderNo=4500969111&postalCode=37040&CSRFToken=" & csrft; вы можете увидеть ваши параметры там.

Option Explicit
Public Sub GetInfo()
    Dim html As HTMLDocument, csrft As String  '<  VBE > Tools > References > Microsoft HTML Object Library
    Set html = New HTMLDocument

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

        html.body.innerHTML = .responseText

        csrft = html.querySelector("[name=CSRFToken]").Value

        .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=4500969111&postalCode=37040&CSRFToken=" & csrft

        html.body.innerHTML = .responseText
    End With

    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

    Dim results()
    results = Array(shipping, qtyOrdered, qtyShipped, product)
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Resize(1, UBound(results) + 1) = results
End Sub

---

Пример цикла:

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