使用VBA从span类中提取值

Question

我正在使用VBA通过.getElementsByClassName从HTML中提取值，但目前没有太多成功。

我正在尝试从以下HTML中提取“20+”

<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 中仅出现一次。

感谢您的帮助。

- Ian

---

你能分享一下这个网站的URL吗？ - Ryan Wildry

当你运行你的代码时会发生什么？ - Tim Williams

Ryan，网址是https://www.toolstation.com。例如：https://www.toolstation.com/2-column-radiator/p39711。 - Ian

Tim，单元格没有填充是因为我在 On Error Resume Next 错误处理中运行代码。 - Ian

Answer 1

这里有一个小例子，它应该会返回Sheet1中单元格A1的文本。你需要使用outerText属性。这仅用于演示目的，如果你想让其更快速和易于维护，请使用Web请求。

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

- Ryan Wildry

---

谢谢Ryan。完美地运作了。我一直在尝试从HTML中提取直接信息，而不是像你的例子中那样加载URL。谢谢。是否可以从HTML中提取信息，还是必须使用CreateObject("internetexplorer.application...等等？ - Ian

在我的示例中，您可以访问.Document中的所有HTML。您可以在With...End With部分之间获取所需内容。 - Ryan Wildry

Answer 2

如果可用，使用API。在这种情况下，有一个API可以传递股票代码。这样更有效和可靠。

使用JSON解析器（建议）：

如果您想要JSON解析器的安全性（例如jsonconverter.bas），则可以按照以下步骤操作。将.bas文件添加到您的项目中后，转到vbe>工具>引用，并添加对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

- QHarr

---

谢谢QHarr。看起来非常有趣。这是我尚未尝试过的方法。我今晚会去看一下。再次感谢。Ian。 - Ian

API运作得非常好。-谢谢。我可以看到一个全新的API世界在我面前展开。谢谢。 - Ian

不用担心。如果有API可用，那就走API的路线。 - QHarr

@QHarr 作为分析 HTTP 请求的替代方案，您可以使用 WorksheetFunction.FilterXML(sResponse, "//span[@class='delivery-stock-value']")，如果 sResponse 返回一个格式良好的 XML 结构。 - T.M.