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

时间:2016-08-21 01:42:09

标签: xml excel vba api ebay

我正在尝试将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

这段代码会给我这样的输出 image

数据完全混淆了 例如" johnk"没有地址2,但代码给了它" marilyn43"的价值 还有," macchi"没有电子邮件,代码给了它" marilyn"值

有什么不对?也许我需要For循环中的指针?或者这个For循环是完全错误的?

1 个答案:

答案 0 :(得分:1)

正如@TimWilliams建议的那样,您需要准确地遍历XML,因为所需的值嵌套在<Order>的所有后代的不同区域中。只有标题 ItemID <Item>的子项。

使用XPath&#39; 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