在VBA中从XML响应中提取数据
我试图从eBay API XML响应提取节点到单个订单行
Sub GetSellerTransactions() Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1") URL = "https://api.ebay.com/ws/api.dll" objHTTP.Open "POST", URL, False objHTTP.setRequestHeader "X-EBAY-API-DEV-NAME", "________" objHTTP.setRequestHeader "X-EBAY-API-CERT-NAME", "________" objHTTP.setRequestHeader "X-EBAY-API-APP-NAME", "________" objHTTP.setRequestHeader "X-EBAY-API-CALL-NAME", "GetSellerTransactions" objHTTP.setRequestHeader "X-EBAY-API-SITEID", "0" objHTTP.setRequestHeader "X-EBAY-API-REQUEST-Encoding", "XML" objHTTP.setRequestHeader "X-EBAY-API-COMPATIBILITY-LEVEL", "967" objHTTP.send (body) Set objXML = New MSXML2.DOMDocument objXML.LoadXML (objHTTP.ResponseText) Dim xItemList As IXMLDOMNodeList Set xItemList = objXML.SelectNodes("//Item") Row = 1 Dim xItem As IXMLDOMNode Dim copy As Worksheet For Each xItem In xItemList Cells(Row, 1) = xItem.SelectNodes("//Buyer/UserID").Item(0).Text Cells(Row, 2) = xItem.SelectNodes("//Buyer/Name").Item(0).Text Cells(Row, 3) = xItem.SelectNodes("///Buyer/Phone").Item(0).Text Cells(Row, 4) = xItem.SelectNodes("//Buyer/Email").Item(0).Text Row = Row + 1 Next Set objHTTP = Nothing Set objXML = Nothing End Sub 这段代码会给我这个图像的输出
数据是完全混淆了，例如“johnk”没有地址2，但代码也给了它“marilyn43”的价值，“macchi”没有电子邮件，代码给了它“玛丽莲”的价值
哪里不对？ 也许我需要在循环中的指针？ 或者这个For循环是完全错误的？
正如@TimWilliams所build议的那样，您需要准确地遍历XML，因为所需的值嵌套在<Order>所有后代的不同区域中。 只有Title和ItemID是<Item>子<Item> 。
考虑使用XPath的descendant进行以下调整，并确保为未声明的名称空间设置前缀。 此外，尝试使用SelectSingleNode()因为您正在为每个项目提取一个值：
Sub GetSellerTransactions() On Error Goto ErrHandle Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1") URL = "https://api.ebay.com/ws/api.dll" objHTTP.Open "POST", URL, False objHTTP.setRequestHeader "X-EBAY-API-DEV-NAME", "________" objHTTP.setRequestHeader "X-EBAY-API-CERT-NAME", "________" objHTTP.setRequestHeader "X-EBAY-API-APP-NAME", "________" objHTTP.setRequestHeader "X-EBAY-API-CALL-NAME", "GetSellerTransactions" objHTTP.setRequestHeader "X-EBAY-API-SITEID", "0" objHTTP.setRequestHeader "X-EBAY-API-REQUEST-Encoding", "XML" objHTTP.setRequestHeader "X-EBAY-API-COMPATIBILITY-LEVEL", "967" objHTTP.send (body) Set objXML = New MSXML2.DOMDocument objXML.async = False objXML.LoadXML (objHTTP.ResponseText) XmlNamespaces = "xmlns:doc='urn:ebay:apis:eBLBaseComponents'" objXML.setProperty "SelectionNamespaces", XmlNamespaces objXML.setProperty "SelectionLanguage", "XPath" Dim xItemList As IXMLDOMNodeList Set xItemList = objXML.DocumentElement.SelectNodes("//doc:Transaction") Row = 5 Dim xItem As IXMLDOMNode For Each xItem In xItemList Cells(Row, 1) = xItem.SelectSingleNode("ancestor::doc:Order/doc:BuyerUserID").Text Cells(Row, 2) = xItem.SelectSingleNode("ancestor::doc:Order/descendant::doc:ShipToAddress[1]/doc:Name").Text Cells(Row, 3) = xItem.SelectSingleNode("ancestor::doc:Order/descendant::doc:ShipToAddress[1]/doc:Phone").Text Cells(Row, 4) = xItem.SelectSingleNode("ancestor::doc:Order/descendant::doc:Buyer/doc:Email").Text Cells(Row, 5) = xItem.SelectSingleNode("ancestor::doc:Order/descendant::doc:ShipToAddress/doc:Street1").Text Cells(Row, 6) = xItem.SelectSingleNode("ancestor::doc:Order/descendant::doc:ShipToAddress/doc:Street2").Text Cells(Row, 7) = xItem.SelectSingleNode("ancestor::doc:Order/descendant::doc:ShipToAddress/doc:StateOrProvince").Text Cells(Row, 8) = xItem.SelectSingleNode("ancestor::doc:Order/descendant::doc:ShipToAddress/doc:PostalCode").Text Cells(Row, 9) = xItem.SelectSingleNode("ancestor::doc:Order/descendant::doc:ShipToAddress/doc:CountryName").Text Cells(Row, 10) = xItem.SelectSingleNode("descendant::doc:Item/doc:ItemID").Text Cells(Row, 11) = xItem.SelectSingleNode("descendant::doc:Item/doc:Title").Text Cells(Row, 12) = xItem.SelectSingleNode("doc:TransactionID").Text Cells(Row, 13) = xItem.SelectSingleNode("descendant::doc:NameValueList[1]/doc:Name").Text Cells(Row, 14) = xItem.SelectSingleNode("descendant::doc:NameValueList[position()=1]/doc:Value").Text Cells(Row, 15) = xItem.SelectSingleNode("descendant::doc:NameValueList[2]/doc:Name").Text Cells(Row, 16) = xItem.SelectSingleNode("descendant::doc:NameValueList[position()=2]/doc:Value").Text Row = Row + 1 Next xItem Set objHTTP = Nothing Set objXML = Nothing Exit Sub ErrHandle: ' MISSING NODE ERROR If Err.Number = 91 Then Resume Next ' ALL OTHER ERRORS Else: MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR" Exit Sub End If End Sub