VBA:对 DOMDocument 的 Html 响应

Question

我正在尝试自动解析一个网站(例如 http://www.delhaizedirect.be/nl/Search/Duvel 并获取 VBA 中列表中第一项的价格。因此，我得到了 HTML，效果很好。但是当我解析将 HTML 转换为 DOMDocument 并应用 XPath 查询，我没有得到任何结果。

这是我正在使用的代码:

Public Function zoekDelhaizePrijs(Artikel As String)

Dim URL As String
URL = "http://www.delhaizedirect.be/nl/Search/" + Artikel

Dim website As Object
Set website = CreateObject("MSXML2.ServerXMLHTTP.6.0")

Call website.Open("GET", URL, False)
Call website.Send("")

Dim XPathQuery As String
XPathQuery = "/html/body/div[1]/div[3]/div[1]/div[1]/div[3]/ul/div[1]/div/div[2]/p[1]"

Dim dom As DOMDocument60
Set dom = New DOMDocument60
dom.async = False

dom.validateOnParse = False

'Debug.Print website.responseText

dom.LoadXML website.responseText
dom.setProperty "SelectionLanguage", "XPath"

Dim node As IXMLDOMNodeList
Set node = dom.SelectNodes(XPathQuery)

Dim title As IXMLDOMNode

For Each title In node
    Debug.Print title.Text
Next

End Function

有人知道吗？

提前致谢，汤姆

Answer 1

尽管页面顶部的 DOCTYPE 将其声明为“XHTML 1.0 Transitional”，但为“Duvel”查询返回的页面甚至不是格式良好的 XML。因此，它无法解析为 DOMDocument60 对象，因此不会返回任何节点。即使您设置了 validateOnParse=False ，这并没有消除文档必须是格式良好的 XML 的要求。

您可以将网站的响应加载到字符串中，然后手动将其更正为格式正确的 XML，然后再将其加载到 DOMDocument60 中。这可能需要一些时间，因为您需要解决问题，运行函数，然后检查 dom.parseError 的属性找到下一个问题。

XHTML 文档的问题包括:

• &未替换为 & 的字符实体 - 例如value="/nl/Search/Duvel?NB_REPLY=20&brand=Delhaize&page=1"而不是value="/nl/Search/Duvel?NB_REPLY=20&brand=Delhaize&page=1"
• 没有值的属性 - 例如<option selected value="/nl/Search/Duvel?NB_REPLY=20&page=1">而不是<option selected="selected" value="/nl/Search/Duvel?NB_REPLY=20&page=1">
• 标签未关闭 - 例如<div><p></p><p></p><p><span><span></span></span></div> (缺少 </p> )

还有一些特定的 MSXML2 问题。默认情况下，DOMDocument60 中禁止 DTD，因此您需要 dom.setProperty "ProhibitDTD", False在尝试加载 XML 之前。

您的 XPath 查询也可能会遇到 MSXML2 的默认 namespace 问题 - 请参阅 here (该链接指的是 MXSML 4.0，但问题在 MSXML 6.0 中仍然存在)。由于页面有一个默认的命名空间xmlns="http://www.w3.org/1999/xhtml" ，您需要:

• 声明与该命名空间相对应的命名空间前缀 dom.setProperty "SelectionNamespaces", "xmlns:r='http://www.w3.org/1999/xhtml'"和
• 在您的 XPath 查询中使用它 XPathQuery = "/r:html/r:body/r:div[1]/r:div[3]/r:div[1]/r:div[1]/r:div[3]/r:ul/r:div[1]/r:div/r:div[2]/r:p[1]"

或者，您可以尝试将网站的响应加载到 HTMLDocument 中，并使用类似 getElementsByClassName 的方法。来定位所需的数据。在本例中，不要求文档是格式良好的 XML

这些是我需要进行的替换，以使 Duvel 页面正常工作。该网站上的其他页面可能需要一组不同的替换。我不会说这是最佳实践，但它适用于这一特定页面。标准实体(加上   )被临时重命名以允许不正确的 &文档中要替换的字符。  被替换为等价的数字:

Dim webResponse As String
webResponse = website.responseText
webResponse = Replace(webResponse, " ", "^nbsp;")
webResponse = Replace(webResponse, "&", "^amp;")
webResponse = Replace(webResponse, "<", "^lt;")
webResponse = Replace(webResponse, ">", "^gt;")
webResponse = Replace(webResponse, """, "^quot;")
webResponse = Replace(webResponse, "'", "^apos;")

webResponse = Replace(webResponse, "&", "&")

webResponse = Replace(webResponse, "^nbsp;", " ")
webResponse = Replace(webResponse, "^amp;", "&")
webResponse = Replace(webResponse, "^lt;", "<")
webResponse = Replace(webResponse, "^gt;", ">")
webResponse = Replace(webResponse, "^quot;", """)
webResponse = Replace(webResponse, "^apos;", "'")

webResponse = Replace(webResponse, "<option selected ", "<option selected=" & Chr$(34) & "selected" & Chr$(34) & " ")
webResponse = Replace(webResponse, " style=>", " style=" & Chr$(34) & Chr$(34) & ">")
webResponse = Replace(webResponse, "]]&gt;", "]]>")
webResponse = Replace(webResponse, "<span>prijs</span></span>", "<span>prijs</span></span></p>")