从 HTML 源中提取值

Question

我有一个用于访问网站的宏，它从代码的特定部分从 A 列中提取一个值，例如 517167000，然后将该值返回到一个单元格。 html 源现在已经改变，我似乎无法让它工作。

我原来的代码是

Public Function UnitPerBox(searchTerm As String) As String
Static request As Object
If request Is Nothing Then Set request = CreateObject("msxml2.xmlhttp")

With request
    .Open "GET", "https://larsonjuhl.co.uk/mouldings/larson-juhl-essentials/arq-essentials-moulding-" & searchTerm, False
    .send
    UnitPerBox = Trim(Split(Split(.responseText, "Units per box</td>")(1), "<tr")(0))
End With

End Function

所以网站的一个工作示例是

https://larsonjuhl.co.uk/mouldings/larson-juhl-essentials/arq-essentials-moulding-517167000

这样你就可以去网站查看源代码了。 新的 html 代码如下所示，但距离我做原始宏已经很久了，我认为我可以改变

"Units per box</td>")(1), "<tr" 

到

"Units per pack</td> <td class="value">")(1), "<tr"

因为下面的新 html 代码是现在网站上的内容，例如我需要值 2.74，但它不起作用。

<tr>
                <td class="name">Units per pack</td>
                <td class="value">2.74</td>
            </tr>

任何帮助将不胜感激。

一个例子 干杯

Answer 1

如果您使用.responseText 使用Split() 进行文本操作，您不妨使用正则表达式而不设置它的Global 参数：

Public Function UnitPerBox(searchTerm As String) As String
Static request As Object
If request Is Nothing Then Set request = CreateObject("msxml2.xmlhttp")

Dim RegEx As Object
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Pattern = "\d+(?:\.\d+)?"

With request
    .Open "GET", "https://larsonjuhl.co.uk/mouldings/larson-juhl-essentials/arq-essentials-moulding-" & searchTerm, False
    .send
    UnitPerBox = RegEx.Execute(Split(.responsetext, "Units per pack</td>")(1))(0)
End With

End Function

---

然而，整洁 (IMO) 是为了避免对 .responseText 进行文本操作，并通过 HTML 文档工作，通过元素 ID 和表索引从 HTML 表中检索适当的数据：

Public Function UnitPerBox(searchTerm As String) As String
Static request As Object
If request Is Nothing Then Set request = CreateObject("msxml2.xmlhttp")
Dim htmlResponse As Object: Set htmlResponse = CreateObject("htmlfile")

With request
    .Open "GET", "https://larsonjuhl.co.uk/mouldings/larson-juhl-essentials/arq-essentials-moulding-" & searchTerm, False
    .send
    htmlResponse.body.innerHTML = .responseText
    UnitPerBox = htmlResponse.body.document.getElementById("specifications").getElementsByTagName("tr")(10).getElementsByTagName("td")(1).innerText
End With

End Function

请注意，该表是 0 索引的，这意味着我们实际上是从第 11 行第二列中检索我们的值。如果您不确定 tablecontent 是否总是在相同的索引上找到，您也可以循环子节点：

Public Function UnitPerBox(searchTerm As String) As String
Static request As Object
If request Is Nothing Then Set request = CreateObject("msxml2.xmlhttp")
Dim htmlResponse As Object: Set htmlResponse = CreateObject("htmlfile")
Dim Rws As Object

With request
    .Open "GET", "https://larsonjuhl.co.uk/mouldings/larson-juhl-essentials/arq-essentials-moulding-" & searchTerm, False
    .send
    htmlResponse.body.innerHTML = .responseText
    Set Rws = htmlResponse.body.document.getElementById("specifications").getElementsByTagName("tr")
    For Each Rw In Rws
        If Rw.getElementsByTagName("td")(0).InnerText = "Units per pack" Then
            UnitPerBox = Rw.getElementsByTagName("td")(1).InnerText
            Exit For
        End If
    Next
End With

End Function

我个人更喜欢使用 HTML 文档而不是文本操作，以上所有选项都可以检索您的值 =)