Search code examples
excelxmlvbaebay-api

Extracting data from XML response in VBA

I am trying to extract nodes from eBay API XML response into single order lines

 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

This code gives me the following output:output

The data is completely mixed up, for example

  • "johnk" doesn't have an Address 2, but the code gave it "marilyn43's" value
  • "macchi" doesn't have an email, and the code gave it "marilyn43's" value

what is wrong? Maybe I need pointers in the for loop? Or is this for loop completely wrong?

Solution

  • As @TimWilliams suggests, you need to accurately traverse your XML as those needed values are nested in different areas all descendants of <Order>. Only Title and ItemID are children of <Item>.

    Consider the following adjustment using XPath's descendant and be sure to set a prefix to the undeclared namespace. Also, try using SelectSingleNode() as you are extracting one value per item:

    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