Не удается получить текст внутри тега <p>с помощью VBA

Question

У меня есть следующий URL

https://www.wavemotion.gr/shop/smartphone-accessories/easy-one-touch-wireless-fast-charging-mount

Я пытаюсь получить доступность продукта с помощью следующего

For i = 2 To lastrow

mylink = wks.Cells(i, 2).Value

ie.Navigate mylink

While ie.Busy Or ie.ReadyState < 4: DoEvents: Wend
t = Timer
Do
    DoEvents
    On Error Resume Next

    Set instock = ie.Document.querySelector(".stock.in-stock").innerText

    If instock Is Nothing Then
    Set availability = ie.Document.querySelector(".stock.out-of-stock").innerText
    Else
    Set availability = instock
    End If

    wks.Cells(i, "D") = availability


    If Timer - t > MAX_WAIT_SEC Then Exit Do
    On Error GoTo 0
Loop

Next i

Но я всегда получаю ничего на

Set instock = ie.Document.querySelector(".stock.in-stock").innerText

Я проверил запрос на

https://try.jsoup.org/

Работает

Что я здесь не так делаю? Не существует идентификатора для назначения только имени класса

<p class="stock in-stock">Διαθέσιμο</p>

Answer 1

Есть лучший, более быстрый способ.Используйте xmlhttp и проанализируйте эту информацию из json, сохраненного в одном из тегов сценария.Если вы отправляете большое количество запросов, вам может потребоваться добавить ожидание для каждого x количества запросов в случае дросселирования / блокировки.Примечание. Вы можете использовать тот же подход с InternetExplorer и, таким образом, удалить многие строки кода, хотя у вас есть другая зависимость от библиотеки (.bas).

Вам необходимо установить jsonconverter.bas из здесь и зайдите в vbe> инструменты> ссылки> и добавьте ссылку на Microsoft Scripting Runtime

Option Explicit
Public Sub GetStocking()
    Dim json As Object, html As HTMLDocument
    Set html = New HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.wavemotion.gr/shop/smartphone-accessories/easy-one-touch-wireless-fast-charging-mount", False
        .send
        html.body.innerHTML = StrConv(.responseBody, vbUnicode)
    End With

    Set json = JsonConverter.ParseJson(html.querySelector("script[type='application/ld+json']").innerHTML)

    Debug.Print json("offers")("availability")
End Sub

---

Вот что содержит весь json:

---

Версия Internet Explorer:

Option Explicit
Public Sub GetInfo()
    Dim ie As New InternetExplorer, i As Long, s As String, scripts As Object, json As Object
    With ie
        .Visible = False
        .Navigate2 "https://www.wavemotion.gr/shop/smartphone-accessories/easy-one-touch-wireless-fast-charging-mount"

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

        Set scripts = .document.querySelectorAll("script[type='application/ld+json']")

        For i = 0 To scripts.Length - 1
            s = scripts.item(i).innerHTML
            If InStr(s, "availability") > 0 Then
                Set json = JsonConverter.ParseJson(s)
                Exit For
            End If
        Next
        .Quit
        If Not json Is Nothing Then Debug.Print json("offers")("availability")
    End With
End Sub

Answer 2

Итак, здесь происходит то, что вы пытаетесь Set тип строки данных innerText для переменной объекта instock. Причина, по которой он возвращает Nothing, заключается в том, что ваш оператор On Error Resume Next подавляет сообщение об ошибке. Если вы возьмете это и запустите, вы получите Type Mismatch. Что вам нужно сделать, это разбить его на строку, которая присваивает объект переменной объекта, а затем строку, которая читает innerText назначенного объекта.

Set instock = ie.Document.querySelector(".stock.in-stock")

If instock Is Nothing Then
    Set availability = ie.Document.querySelector(".stock.out-of-stock")
Else
    Set availability = instock
End If

wks.Cells(i, "D") = availability.innerText