Get the values of id2 - excel

<?xml version="1.0" encoding="UTF-8"?>
<s:Envelope xmlns:s="http://schemas.xmlsoap.org/soap/envelope/">
<s:Body xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
<id xmlns="id.services/">
<ids1>
<response xmlns="">
<ids xmlns="ids">
<Id-info xmlns="" id0="123" id1="0" id2="2345" />
<Id-info xmlns="" id0="456" id1="1" id2="6789" />
</ids>
</response>
</ids1>
</id>
</s:Body>
</s:Envelope>
How can I get the values of id2 using vba excel?. This is the code that I have tried
Dim xmlDoc As DOMDocument30
Set xmlDoc = New DOMDocument30
xmlDoc.Load ("C:test.xml")
Dim id As String
id = xmlDoc.SelectSingleNode("//ids/Id-info").Attributes.getNamedItem("id2").Text

You will only access one value with that.
Try
Option Explicit
Public Sub test()
Dim xmlDoc As Object, items As Object, node As IXMLDOMElement
Set xmlDoc = CreateObject("MSXML2.DOMDocument") 'New MSXML2.DOMDocument60
With xmlDoc
.validateOnParse = True
.setProperty "SelectionLanguage", "XPath"
.async = False
If Not .Load("C:\Users\User\Desktop\Test.xml") Then
Err.Raise .parseError.ErrorCode, , .parseError.reason
End If
End With
Set items = xmlDoc.SelectNodes("//Id-info")
If Not items Is Nothing Then
For Each node In items
Debug.Print node.getAttribute("id2")
Next
End If
End Sub

Related

Parse SOAP XML Response in VBA

We are trying to parse the below response and get the value "123456" from "result" tag using VBA Code but we are not getting anything:
Response Received:
------=_Part_119884_965967558.1620391101235
Content-Type: application/xop+xml;charset=utf-8;type="text/xml"
Content-Transfer-Encoding: 8bit
Content-ID: <e119e24d-e0b6-4ceb-a00a-dd094ef91ef7>
<?xml version="1.0" encoding="utf-8" ?>
<env:Envelope
xmlns:env="http://schemas.xmlsoap.org/soap/envelope/"
xmlns:wsa="http://www.w3.org/2005/08/addressing">
<env:Header>
<wsa:Action>http://xxxx</wsa:Action>
<wsa:MessageID>urn:uuid:xxxx</wsa:MessageID>
</env:Header>
<env:Body>
<ns0:uploadFileResponse
xmlns:ns0="http://xxxx">
<result
xmlns="http://xxxx">123456
</result>
</ns0:uploadFileResponse>
</env:Body>
</env:Envelope>
------=_Part_119884_965967558.1620391101235--
VBA Code:
Dim xmldoc As Object
Dim xmlnode As Object
Set xmldoc = CreateObject("Microsoft.XMLDOM")
xmldoc.SetProperty "SelectionLanguage", "XPath"
xmldoc.async = False
xmldoc.LoadXML .ResponseText
For Each xmlnode In xmldoc.SelectNodes("//*[contains(name(),'result')]")
Debug.Print "Document ID: "; xmlnode.text
Next
Please help
You need to clean-up the response.
Dim xmldoc As Object
Dim xmlnode As Object
Set xmldoc = CreateObject("Microsoft.XMLDOM")
xmldoc.SetProperty "SelectionLanguage", "XPath"
xmldoc.async = False
Dim xml As String
xml = .ResponseText
xml = Mid(xml, InStr(1, xml, "<?xml "))
xml = Left(xml, InStr(1, xml, "Envelope>") + Len("Envelope"))
If xmldoc.LoadXML(xml) = True Then
For Each xmlnode In xmldoc.SelectNodes("//*[contains(name(),'result')]")
Debug.Print "Document ID: "; xmlnode.Text
Next
Else
MsgBox "XML failed to load", vbCritical
End If

Import XML data using Excel VBA

I'm trying to import specific data from and XML file to an Excel sheet.
The code I'm using is this.
Dim oXMLFile As New DOMDocument60
Dim books As IXMLDOMNodeList
Dim results() As String
Dim i As Integer, booksUBound As Integer
Dim book As IXMLDOMNode, title As IXMLDOMNode, author As IXMLDOMNode
oXMLFile.Load "C:\example.xml"
Set books = oXMLFile.SelectNodes("/OUT_MESSAGE/LINES/OUT_MESSAGE_LINE")
booksUBound = books.Length - 1
ReDim results(booksUBound, 1)
For i = 0 To booksUBound
Set book = books(i)
Set title = book.SelectSingleNode("C00")
If Not title Is Nothing Then results(i, 0) = title.Text
Next
Dim wks As Worksheet
Set wks = ActiveSheet
wks.Range(wks.Cells(1, 1), wks.Cells(books.Length, 2)) = results
Which works with this XML
<?xml version="1.0" encoding="UTF-8"?>
<OUT_MESSAGE>
<LINES>
<OUT_MESSAGE_LINE>
<C00>1231231</C00>
<C01>3213213</C01>
</OUT_MESSAGE_LINE>
<OUT_MESSAGE_LINE>
<C00>1231234</C00>
<C01>3213214</C01>
</OUT_MESSAGE_LINE>
</LINES>
</OUT_MESSAGE>
My problem is that my XML file looks like this.
<?xml version="1.0" encoding="UTF-8"?>
<OUT_MESSAGE xmlns="urn:randomaddress-com:schema:test_out_message" xmlns:xsi="http://www.randomurl.com/123">
<LINES>
<OUT_MESSAGE_LINE>
<C00>1231231</C00>
<C01>3213213</C01>
</OUT_MESSAGE_LINE>
<OUT_MESSAGE_LINE>
<C00>1231234</C00>
<C01>3213214</C01>
</OUT_MESSAGE_LINE>
</LINES>
</OUT_MESSAGE>
Which I originally thought I could simply get to work by replacing
Set books = oXMLFile.SelectNodes("/OUT_MESSAGE/LINES/OUT_MESSAGE_LINE")
With
Set books = oXMLFile.SelectNodes("/OUT_MESSAGE xmlns='urn:randomaddress-com:schema:test_out_message' xmlns:xsi='http://www.randomurl.com/123'/LINES/OUT_MESSAGE_LINE")
But that gives me a runtime error.
If anyone know what changes I have to do to the original code that would be much appreciated.
This worked for me:
Dim xDoc, nodes, oNode
Set xDoc = CreateObject("MSXML2.DOMDocument.6.0")
'Note: added an `x=` to the default namespace so we can reference it later
xDoc.setProperty "SelectionNamespaces", _
"xmlns:x='urn.randomaddress.com.schema.test_out_message'"
xDoc.LoadXML Sheet2.Range("A4").Value 'load XML from sheet
'use the "x" prefix we added above
Set nodes = xDoc.SelectNodes("/x:OUT_MESSAGE/x:LINES/x:OUT_MESSAGE_LINE")
Debug.Print nodes.Length ' = 1
For Each oNode In nodes
Debug.Print oNode.SelectSingleNode("x:C00").nodeTypedValue
Debug.Print oNode.SelectSingleNode("x:OBJSTATE").nodeTypedValue
'etc
Next oNode
using this XML:
<?xml version="1.0"?>
<OUT_MESSAGE xmlns="urn.randomaddress.com.schema.test_out_message"
xmlns:xsi="http://www.randomurl.com/123">
<LINES>
<OUT_MESSAGE_LINE>
<C00>321312</C00>
<C01>12312312</C01>
<OBJSTATE>Posted</OBJSTATE>
<OBJEVENTS>Accept^Reject^</OBJEVENTS>
<STATE>Posted</STATE>
</OUT_MESSAGE_LINE>
</LINES>
</OUT_MESSAGE>

Create new XML Element as a Parent Node of Existing Element

I would like to create a new XML element to make my existing XML node as a child node of this new element. The structure of my current XML file is:
<?xml version="1.0" encoding="utf-8"?>
<component>
<type name="A"></type>
<type name="B"></type>
</component>
My idea is to create new element "masterType" and make it as a parent node of existing "type" element.
<?xml version="1.0" encoding="utf-8"?>
<component>
<masterType>
<type name="A"></type>
<type name="B"></type>
</masterType>
</component>
My question is, how can I make this new element as a parent node of my existing xml node? What happens if I used insertBefore(), the "masterType" already ends before the element "type".
<?xml version="1.0" encoding="utf-8"?>
<component>
<masterType>
</masterType>
<type name="A"></type>
<type name="B"></type>
</component>
Here's my code
Dim fileName As String
fileName = ActiveSheet.OLEObjects("TextBox1").Object.Text
XMLFileName = fileName
Dim Found As Boolean
Dim docXMLDOM As DOMDocument
Dim nodeType As IXMLDOMNodeList
Dim nodElement As IXMLDOMElement
Dim nodNewElement As IXMLDOMElement
Dim nodReference As IXMLDOMElement
Set docXMLDOM = New DOMDocument
docXMLDOM.Load XMLFileName
Set nodeType = docXMLDOM.getElementsByTagName("type")
For Each nodElement In nodeType
If nodElement.Attributes.getNamedItem("name").Text = "A" Then
Set nodReference = nodElement
Set nodNewElement = docXMLDOM.createElement("masterType")
nodElement.ParentNode.InsertBefore nodNewElement, nodElement
Exit For
End If
Next
docXMLDOM.Save XMLFileName
Simplified example:
Sub AddParentNode()
Dim docXMLDOM As MSXML2.DOMDocument60
Dim els As IXMLDOMNodeList
Dim masterEl As IXMLDOMElement
Dim el As IXMLDOMElement
Set docXMLDOM = New MSXML2.DOMDocument60
docXMLDOM.LoadXML Range("A1").Value 'for testing
Debug.Print "*** Before ***"
Debug.Print docXMLDOM.XML
Set els = docXMLDOM.getElementsByTagName("type")
If els.Length > 0 Then
'create the new parent element
Set masterEl = docXMLDOM.createElement("masterType")
els(1).ParentNode.appendChild masterEl
End If
'append each "type" element into the new parent node
For Each el In els
masterEl.appendChild el.CloneNode(True)
el.ParentNode.RemoveChild el
Next
Debug.Print "*** After ***"
Debug.Print docXMLDOM.XML
End Sub

xpath query with backslashes return empty

I am trying to select a single MSXML2 node in excel using XPath predicates. I am able to select it just fine when I supply a string without backslashes. But as soon as I try with a file path string, the expression returns nothing.
Here is my XML:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<Directory>
<Document>
<Path/>
<Status/>
<Notes/>
</Document>
<Document>
<Path>C:\Users\Ivelin\Desktop\Workspace\Requests\File.xlsm</Path>
<Status>Started</Status>
<Notes/></Document>
<Document>
<Path>TEST</Path>
<Status>Started</Status>
<Notes/>
</Document>
</Directory>
This works:
Dim Stat As IXMLDOMNode
Dim strPath
strPath = "/Directory/Document[Path='TEST']/Status/text()"
MsgBox (strPath)
Set Stat = XDoc.SelectSingleNode(strPath)
MsgBox (Stat.NodeValue)
This returns null:
Dim Stat As IXMLDOMNode
Dim strPath
strPath = "/Directory/Document[Path='C:\Users\Ivelin\Desktop\Workspace\Requests\File.xlsm']/Status/text()"
MsgBox (strPath)
Set Stat = XDoc.SelectSingleNode(strPath)
MsgBox (Stat.NodeValue)
I tried different suggestions, double backslashes etc. but no luck. Since I am interested in file names/paths, I don't really have other option, but to use backslashes.
Any pointers on how to solve this are welcome.
I see nothing wrong with your xpath. Perhaps the error lies elsewhere. I used the following loading your xml from file; no problem.
Option Explicit
Public Sub test()
Dim xmlDoc As Object, item As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument") 'New MSXML2.DOMDocument60
With xmlDoc
.validateOnParse = True
.setProperty "SelectionLanguage", "XPath"
.async = False
If Not .Load("C:\Users\User\Desktop\Test.xml") Then
Err.Raise .parseError.ErrorCode, , .parseError.reason
End If
End With
Dim path As String
path = "/Directory/Document[Path='C:\Users\Ivelin\Desktop\Workspace\Requests\File.xlsm']/Status/text()"
Set item = xmlDoc.SelectSingleNode(path)
Debug.Print item.Text
End Sub

Excel VBA - XML DomDocument return attribute values

I am working with the following XML response in Excel VBA.
<XXXXX docType="GetSegmentSpeed" copyright="Copyright XXXXX Inc." versionNumber="12.9" createdDate="2018-11-26T15:08:37Z" statusId="0" statusText="" responseId="06d3aad3-c3aa-40a5-9d2c-f1ac8f713729">
<SegmentSpeedResultSet coverage="255">
<SegmentSpeedResults timestamp="2018-11-26T15:08:36Z">
<Segment code="213423027" type="XDS" speed="53" average="34" reference="40" score="30" c-value="63" travelTimeMinutes="0.649" speedBucket="3"/>
<Segment code="213423023" type="XDS" speed="53" average="38" reference="41" score="30" c-value="58" travelTimeMinutes="0.603" speedBucket="3"/>
<Segment code="213423026" type="XDS" speed="52" average="34" reference="39" score="30" c-value="71" travelTimeMinutes="0.486" speedBucket="3"/>
<Segment code="213423050" type="XDS" speed="52" average="34" reference="39" score="30" c-value="71" travelTimeMinutes="0.48" speedBucket="3"/>
<Segment code="213423051" type="XDS" speed="52" average="35" reference="39" score="30" c-value="78" travelTimeMinutes="0.486" speedBucket="3"/>
</SegmentSpeedResults>
</SegmentSpeedResultSet>
</XXXXX>
I want to find the total of the travelTimeMinutes attributes of Segments.
To begin with, I thought I would try and get the value for the first segment. This is my code:
Sub SegSetTimes()
' Declare Private Variables
Dim SegString As String 'Segment set to be used for calculation
Dim hReq As New WinHttpRequest 'HttpRequest path
Dim strResp As String 'Response String
Dim xmlDoc As MSXML2.DOMDocument60 'DomDocument for parsing XML
' Import Segment Set
SegString = Join(WorksheetFunction.Transpose(Range("A2", Range("A2").End(xlDown)).Value), "|XDS,")
' Call for real-time segment information
hReq.Open "Get", "http://eu.api.XXXXX.com/Traffic/XXXXX.ashx?Action=GetSegmentSpeed" & "&token=" & AuthToken & "&Segments=" & SegString
hReq.Send
' Create string from response text
strResp = hReq.ResponseText
' Import response text into DomDocument for parsing within VBA
Set xmlDoc = New MSXML2.DOMDocument60
If Not xmlDoc.LoadXML(strResp) Then
MsgBox "Load Error"
End If
Dim n As IXMLDOMNodeList
Set n = xmlDoc.SelectNodes("//XXXXX/SegmentSpeedResultSet/SegmentSpeedResults")
Dim TT As Single
TT = n.Item(0).Attributes.getNamedItem("travelTimeMinutes")
End Sub
It fails with the following error:
Run-time error '91': Object variable or With block variable not set'
When stepping through in Locals, my IXMLDOMNodeList n looks correct. I just cannot see how to get at the values I want to.
Does anybody have any suggestions?
Reading in from a file I use an XPath to get the relevant nodes and then extract the value using getAttribute
Public Sub testing()
Dim xmlDoc As New MSXML2.DOMDocument60, items As Object, item As IXMLDOMElement, total As Double
Set xmlDoc = New MSXML2.DOMDocument60
xmlDoc.Load "C:\Users\User\Desktop\Test.xml"
Set items = xmlDoc.SelectNodes("//Segment[#travelTimeMinutes]")
For Each item In items
total = total + item.getAttribute("travelTimeMinutes")
Next
Debug.Print total
End Sub
Alternatively, consider running XSLT to retrieve the sum() across all nodes without looping:
XSLT (save as .xsl file, a special .xml file to be referenced in VBA)
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:output indent="yes"/>
<xsl:strip-space elements="*"/>
<xsl:template match="/XXXXX">
<result>
<xsl:value-of select="format-number(sum(descendant::Segment/#travelTimeMinutes), '#.###')"/>
</result>
</xsl:template>
</xsl:stylesheet>
XSLT Demo
VBA
Dim xmlDoc As New MSXML2.DOMDocument60, items As Object, item As IXMLDOMElement, total As Double
' NEW REFERENCES
Dim xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60
' RETRIEVE WEB REQUEST
...same code as above...
' LOAD XML AND XSL FILES
xmlDoc.async = False
xml.LoadXML strResp
xslDoc.async = False
xslDoc.Load "C:\Path\to\XSLT\File.xsl"
' TRANSFORM XML
xmlDoc.transformNodeToObject xslDoc, newDoc
' OUTPUT RESULT (NO LOOPING)
Debug.Print newDoc.SelectSingleNode("/result").Text
' 2.704

Resources