VBA для извлечения значения из класса span

Question

Я использую vba для извлечения значения из HTML, используя .getElementsByClassName, но сейчас мне не очень везет.

Я пытаюсь извлечь "20+" из следующего HTML

<p class="delivery-stock">
    <span class="delivery-stock-value">20+</span> 
    <span class="delivery-available f-bold f4">available for delivery:</span>
</p>
<p>

VBA, который я использовал до сих пор:

sh01.Cells(r, 5) = HTML.getElementsByClassName("delivery-stock-value")(0).innertext
sh01.Cells(r, 5) = HTML.getElementsByClassName("delivery-stock-value")(0).value

, и я сделал то же самое, используя класс delivery-stock.

delivery-stock-value &delivery-stock встречается в HTML только один раз.

Заранее благодарим за помощь.

Answer 1

Используйте API, если он доступен. В этом случае есть API, которому вы передаете биржевой код.Это более эффективно и надежно.

С JSONParser (рекомендуется):

Если вы хотите обеспечить безопасность анализатора JSON (например, jsonconverter.bas ), выполните следующие действия.Как только вы добавите .bas в ваш проект, перейдите в vbe> tools> reference и добавьте ссылку на Microsoft Scripting Runtime

Public Sub GetStock()
    Dim json As Object
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.toolstation.com/api/products/39711/delivery?site=WW", False
        .send
        Set json = JsonConverter.ParseJson(.responseText)
    End With
    Debug.Print json("data")("channels")("delivery")("stock")
End Sub

Без анализатора JSON (не рекомендуется):

Public Sub GetStock()
    Dim sResponse As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.toolstation.com/api/products/39711/delivery?site=WW", False
        .send
        sResponse = .responseText
    End With
    Debug.Print Split(Split(sResponse, "stock" & Chr$(34) & ":")(1), ",")(0)
End Sub

Answer 2

Вот небольшой пример, который должен вернуть текст в ячейку A1 в Sheet1.Вы хотите outerText свойство.Это только для демонстрационных целей, если вы хотите, чтобы это было быстрее и проще в обслуживании, используйте веб-запрос.

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub GetTheText()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim text As String

    With CreateObject("internetexplorer.application")
        .Navigate "https://www.toolstation.com/2-column-radiator/p39711"
         Do While .Busy And .readyState <> 4:DoEvents:Loop
         Sleep 1000 ' wait a little bit too
         text = .document.getElementsByClassName("delivery-stock-value")(0).outerText
        .Quit
    End With

    ws.Cells(1, 1).Value = text
End Sub