从 VBA 中的 XML 响应中提取数据

Question

我正在尝试从 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's" 值
"macchi" 没有电子邮件，代码给了它 "marilyn43's" 值

怎么了？也许我需要 for 循环中的指针？或者这个 for 循环完全错误？

Answer 1

正如@TimWilliams 所建议的，您需要准确遍历 XML，因为这些所需的值嵌套在 <Order> 的所有后代的不同区域中。只有 Title 和 ItemID 是 <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

从 VBA 中的 XML 响应中提取数据

Extracting data from XML response in VBA

xml

excel

vba

ebay-api