VBA:DOMDocument的Html响应

我正在尝试自动解析一个网站（例如，在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

有人知道吗

提前感谢,， 汤姆

这对我很有用：

//div[@class="displayProdList"][1]//p[@class="prodListPrice"]

---

尽管页面顶部的DOCTYPE声明它为“XHTML1.0过渡版”，但页面返回的是“Duvel”查询甚至不是格式良好的XML。因此，它无法解析为DOMDocument60对象，因此不会返回任何节点。即使您设置了

validateOnParse=False

，这也不会删除文档格式良好XML的要求

您可以将来自网站的响应加载到字符串中，然后在将其加载到DOMDocument60之前手动将其更正为格式良好的XML。这可能需要一些时间，因为您需要修复问题，运行函数，然后检查

dom.parseError

的属性以查找下一个问题

XHTML文档的问题包括：

• 和
  字符未被
  实体替换-例如
  值=“/nl/Search/Duvel？NB_REPLY=20&brand=Delhaize&page=1”
  而不是
  值=“/nl/Search/Duvel？NB_REPLY=20&；brand=Delhaize&page=1”

• 没有值的属性-例如，
  而不是

• 标记未关闭-例如

  （缺少一个
  ）

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

dom.setProperty“ProhibitDTD”，False

您的XPath查询也可能与MSXML2的默认名称空间问题相冲突-请参阅（该链接指的是MXSML 4.0，但问题仍然存在于MSXML 6.0中）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[3]/r:ul/r:div[1]/r:div/r:div/r:div[2]/r:p[1]”

或者，您可以尝试将来自网站的响应加载到HTMLDocument中，并使用类似

GetElementsByCassName

的方法来定位所需的数据。在这种情况下，文档不需要格式良好的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>")

Dim webResponse作为字符串
webResponse=website.responseText
webResponse=替换（webResponse，“，“^nbsp；”）
webResponse=替换（webResponse，“&；”、“^amp；”）
webResponse=替换（webResponse，“，“^lt；”）
webResponse=替换（webResponse，“，“^gt；”）
webResponse=替换（webResponse，“，“^quot；”）
webResponse=替换（webResponse，“&apos；”，“^apos；”）
webResponse=Replace（webResponse，“&”、“&；”）
webResponse=替换（webResponse，“^nbsp；”，“ ；”）
webResponse=Replace（webResponse，“^amp；”，“&；”）
webResponse=Replace（webResponse，“^lt；”，“”）
webResponse=Replace（webResponse，“^gt；”，“”）
webResponse=替换（webResponse，“^quot；”，“”）
webResponse=Replace（webResponse，“^apos；”，“&apos；”）
webResponse=替换（webResponse，“”）
webResponse=Replace（webResponse，“]]”，“]]>”）
webResponse=Replace（webResponse，“prijs”，“prijs
”）

您是否使用相同的VBA代码对其进行了测试？如果我使用XPath插件测试查询，它确实可以工作，但与代码不兼容。感谢您提供了这个非常详细的答案！