So I was trying to read the nodes and write their fields on an Excel workbook, however I'm having troubles to index a specific field that I want. The XML structure is like:
<root>
<data name="Admin" xml:space="preserve">
<value>Administrador</value>
</data>
</root>
Now the problem is that I had no problem to get the text inside the node but I also wanted to get the text inside the "" right after data name. The VB code is as it follows:
Dim XDoc As Object
Dim myNodes As IXMLDOMNodeList, myChildNodes As IXMLDOMNodeList
Dim myElement As IXMLDOMElement
Dim myNode As IXMLDOMNode, myChildNode As IXMLDOMNode
Dim nNode As Integer
Dim nChildNode As Integer
Set XDoc = CreateObject("MSXML2.DOMDocument")
XDoc.async = False: XDoc.validateOnParse = False
XDoc.load (vFileName)
Set myNodes = XDoc.SelectNodes("//data/value")
If myNodes.Length > 0 Then
For nNode = 0 To myNodes.Length - 1
Set myNode = myNodes(nNode)
Set myChildNodes = myNode.ChildNodes ' Get the children of the first node.
For nChildNode = 0 To myChildNodes.Length - 1
vNode = myChildNodes(nChildNode).Text
vRange2 = "A" + Trim(Str(vLineTAG))
Range(vRange2).Value = vNode
Next nChildNode
Next nNode
Else
'Stuff and all
End If
So here I'm referencing "value" and vNode is getting the Administrador string inside the node above, but when I reference only data, it returns an empty string, the range which receives it is blanc, and the next child node returns what is inside the value node as expected. Don't know what am I missing here...
This should do the work
Dim ElementAttribute As IXMLDOMAttribute
Set ElementAttribute = myNode.Attributes.getNamedItem("name")
Debug.Print ElementAttribute.Text
Related
I have an XML file with 3 levels. Some of the tags are dynamic.(Please check below XML file)
I have to validate whether the tag "price" is present in all nodes or not and also need to get value of "price tag". I also need to fetch a value of every node present in XML file.
I tried validating whether every node in XML file is present or not but getting an error
VBA code snippet
Function fnReadXMLByTags2()
Dim mainWorkBook As Workbook
Set mainWorkBook = ActiveWorkbook
Dim obj As Object
Set obj = CreateObject("MSXML2.DOMDocument")
obj.async = False
XMLFileName = "C:\Prakash\Demo.xml"
obj.Load (XMLFileName)
Set authorNodes = obj.SelectNodes("//Books/book/author/text()")
Set titleNodes = obj.SelectNodes("//Books/book/title/text()")
Set genreNodes = obj.SelectNodes("//Books/book/genre/text()")
Set priceNodes = obj.SelectNodes("//Books/book/price/text()")
Set publish_dateNodes = obj.SelectNodes("//Books/book/publish_date/text()")
Set languageNodes = obj.SelectNodes("//Books/book/language/text()")
For i = 0 To (authorNodes.Length - 1)
If Not publish_dateNodes Is Nothing Then
Set publish_dateNodesValue = obj.SelectNodes("//Books/book/publish_date/text()")
publish_dateObj = publish_dateNodesValue(i).NodeValue
mainWorkBook.Sheets("Sheet3").Range("E" & i + 2).Value = publish_dateObj
Else
mainWorkBook.Sheets("Sheet3").Range("E" & i + 2).Value = "Blank"
End If
Next
End Function
Below error Message for line …
publish_dateObj = publish_dateNodesValue(i).NodeValue
Runtime error '91':
Object variable or With block variable not set
This is what I'm expecting in Excel file:
Excel sheet output
Below is the xml file :
<?xml version="1.0"?>
<Books>
<book id="1">
<author>ABC</author>
<title>Physics</title>
<genre>asd</genre>
<price>Rs.44</price>
<publish_date>20-10-2001</publish_date>
<description>Book1</description>
</book>
<book id="2">
<author>DEF</author>
<title>Chem</title>
<genre>XYZ</genre>
<publish_date>02-12-2016</publish_date>
<description>Book2</description>
</book>
<book id="3">
<author>GHI</author>
<title>Maths</title>
<genre>ABC</genre>
<price>Rs.500</price>
<language>English</language>
<description>Book3</description>
</book>
</Books>
It should be a procedure (Sub) not a function, because it does not return a value (make sure you know the difference).
The way you read the sub nodes made it impossible to keep the data consitent. You need to read all books first and then for each book the sub nodes:
Set CurrentNode = Books(iBook).SelectNodes("author/text()")(0)
The above reads reads the node author from book number iBook into CurrentNode and if it does not exist then CurrentNode will be Nothing. So you just need to check it and output the .NodeValue.
Note that I introduced an array NodesOutputList to be able to loop through the columns easily instead of repeating similar code over and over.
So you end up with something like:
Option Explicit
Public Sub fnReadXMLByTags2()
Dim mainWorkBook As Workbook
Set mainWorkBook = ThisWorkbook '<-- this is the workbook where this code is in ActiveWorkbook is the worbkook that has focus (is on top)
Dim wsOutput As Worksheet 'define output sheet
Set wsOutput = mainWorkBook.Worksheets("Sheet3")
Dim XMLFileName As String
XMLFileName = "D:\code\Demo.xml"
Dim obj As Object
Set obj = CreateObject("MSXML2.DOMDocument")
obj.async = False
obj.Load XMLFileName '<-- no parenthesis here!!!
Dim Books As Object 'get all books
Set Books = obj.SelectNodes("//Books/book")
Dim NodesOutputList() As Variant 'order in which the nodes are checked and output
NodesOutputList = Array("author/text()", "title/text()", "genre/text()", "price/text()", "publish_date/text()", "language/text()", "description/text()")
Dim iBook As Long
For iBook = 0 To Books.Length - 1 'loop through books
Dim iNode As Long
For iNode = LBound(NodesOutputList) To UBound(NodesOutputList) 'loop through nodes in the list
Dim CurrentNode As Object
Set CurrentNode = Books(iBook).SelectNodes(NodesOutputList(iNode))(0)
If Not CurrentNode Is Nothing Then
wsOutput.Cells(iBook + 2, iNode + 1).Value = CurrentNode.NodeValue
Else
wsOutput.Cells(iBook + 2, iNode + 1).Value = "blank"
End If
Next iNode
Next iBook
End Sub
I'm using VBA to create an XML for a software to read. The problem is when creating the elements, the root element needs an attribute but the attribute is asigned to all elements and I dont see the problem.
I have looked through the various properties and methods on MSDN but can´t find what Im doing wrong
Private Xdoc As DOMDocument
Private Root As IXMLDOMElement
Private Parents As IXMLDOMElement
Private Att As IXMLDOMAttribute
Private Sub CreateRoot()
Page = "http://tempuri.org/SpecificationImportData.xsd"
Set Xdoc = CreateObject("MSXML2.DOMDocument")
Set Att = Xdoc.createAttribute("xmlns")
Set Root = Xdoc.createElement("Specification")
Set Parents = Xdoc.createElement("SpecificationRow") value
Xdoc.appendChild Root
Att.Value = Page
Root.setAttributeNode Att
End Sub
Sub AddChild(Ary() As String)
Dim I As Integer, Elem As IXMLDOMElement, Page As String
I = 0
For Each E In fDom()
Set Elem = Xdoc.createElement(E)
Elem.Text = Ary(I)
Parents.appendChild Elem
I = I + 1
Next
Root.appendChild Parents
End Sub
The Above code creates this:
<Specification xmlns="http://tempuri.org/SpecificationImportData.xsd">
<SpecificationRow xmlns="">
<Data>Values</Data>
</SpecificationRow>
</Specification>
But I need this:
<Specification xmlns="http://tempuri.org/SpecificationImportData.xsd">
<SpecificationRow>
<Data>Values</Data>
</SpecificationRow>
</Specification>
The first sub creates the elements and the second sub gets called form a sub that passes values from an array that AddChild reads. It then creates the XML.
I think you're confusing attributes with namespaces. The document createNode method allows you to create an Element (type=1) with a namespace.
Here's a example:
Private Sub CreateRoot()
Dim strNameSpace As String
strNameSpace = "http://tempuri.org/SpecificationImportData.xsd"
Dim xml As Object
Dim ndRoot As Object
Dim ndParent As Object
Dim ndChild As Object
Set xml = CreateObject("MSXML2.DOMDocument")
Set ndRoot = xml.createNode(1, "Specification", strNameSpace)
xml.appendChild ndRoot
Set ndParent = xml.createNode(1, "SpecificationRow", strNameSpace)
ndRoot.appendChild ndParent
Set ndChild = xml.createNode(1, "Data", strNameSpace)
ndParent.appendChild ndChild
ndChild.Text = "Values"
MsgBox xml.xml
End Sub
This outputs
<Specification xmlns="http://tempuri.org/SpecificationImportData.xsd">
<SpecificationRow>
<Data>Values</Data>
</SpecificationRow>
</SpecificationRow>
I am having problems getting the value of "Data Import" from the source_lvl2 child node. In Excel, I get a run-time error of 91, "Object variable or With block variable not set"
I can't see what I'm doing wrong - any advice?
VBA
Sub TestXML()
Dim XDoc As Object
Set XDoc = CreateObject("MSXML2.DOMDocument")
XDoc.async = False: XDoc.validateOnParse = False
XDoc.Load ("C:\171215-000438_1513346972.xml")
Set lists = XDoc.SelectNodes("/archive/primary_rnw_contact/source/source_lvl2")
Debug.Print lists(0).Attributes(0).Text
Set XDoc = Nothing
End Sub
XML
EXTRA CODE
<?xml version="1.1" encoding="UTF-8"?>
<archive product="RightNow" version="4.0" build="17.8.0.1.0.248" label="Archived Incident">
You could try the following (not tested):
Dim xmap As XmlMap
Dim k as Long
Dim oMyNewColumn As ListColumn
oMyList As ListObject
' Delete all previous XML maps
k = ThisWorkbook.XmlMaps.Count 'Detect all XML maps
For i = 1 To k
ThisWorkbook.XmlMaps(i).Delete
Next i
...
Set xmap = ThisWorkbook.XmlMaps.Add("some_file.xml")
...
Set oMyNewColumn = oMyList.ListColumns.Add
oMyList.ListColumns(3).XPath.SetValue xmap, "/archive/primary_rnw_contact/source/source_lvl2"
I wrote a Subroutine to move a page in a different section compared to the original one but it does't work! May someone help me?
Private Sub CreateInNewSection(onote As OneNote.Application, pageXML As String, newSecId As String, title As String)
Dim pDoc As MSXML2.DOMDocument60
Set pDoc = New MSXML2.DOMDocument60
If pDoc.LoadXML(pageXML) Then
Dim cNodes As MSXML2.IXMLDOMNodeList
Dim fNodes As MSXML2.IXMLDOMNodeList
Dim iNodes As MSXML2.IXMLDOMNodeList
Dim cNode As MSXML2.IXMLDOMNode
Dim fNode As MSXML2.IXMLDOMNode
Dim iNode As MSXML2.IXMLDOMNode
soapNS = "xmlns:one='http://schemas.microsoft.com/office/onenote/2013/onenote'"
pDoc.setProperty "SelectionNamespaces", soapNS
Set cNodes = pDoc.DocumentElement.SelectNodes("//one:T")
Set fNodes = pDoc.DocumentElement.SelectNodes("//one:InsertedFile")
Set iNodes = pDoc.DocumentElement.SelectNodes("//one:Image")
Dim nPageID As String
onote.CreateNewPage newSecId, nPageID, npsDefault
Dim oXML As String
onote.GetPageContent nPageID, oXML, piAll, xs2013
'oXML = pageXML
Dim nDoc As MSXML2.DOMDocument60
Set nDoc = New MSXML2.DOMDocument60
If nDoc.LoadXML(oXML) Then
Dim npNode As MSXML2.IXMLDOMNode
soapNS = "xmlns:one='http://schemas.microsoft.com/office/onenote/2013/onenote'"
nDoc.setProperty "SelectionNamespaces", soapNS
Set npNode = nDoc.SelectSingleNode("//one:Page")
' Find the Title element.
Dim tNode As MSXML2.IXMLDOMNode
Set tNode = nDoc.SelectSingleNode("//one:Page/one:Title/one:OE/one:T")
' Get the CDataSection where OneNote store's the Title's text.
Dim cdataChild As MSXML2.IXMLDOMNode
Set cdataChild = tNode.SelectSingleNode("text()")
' Change the title in the local XML copy.
cdataChild.Text = title
' Write the update to OneNote.
'oneNote.UpdatePageContent doc.XML
'---------- For Text Nodes -----------
For Each cNode In cNodes
If cNode.Text <> "" Then
Dim newTextNodeElement As MSXML2.IXMLDOMElement
Dim newTextNode As MSXML2.IXMLDOMNode
' Create Outline node.
Set newTextNodeElement = nDoc.createElement("one:Outline")
Set newTextNode = npNode.appendChild(newTextNodeElement)
' Create OEChildren.
Set newTextNodeElement = nDoc.createElement("one:OEChildren")
Set newTextNode = newTextNode.appendChild(newTextNodeElement)
' Create OE.
Set newTextNodeElement = nDoc.createElement("one:OE")
Set newTextNode = newTextNode.appendChild(newTextNodeElement)
' Create TE.
Set newTextNodeElement = nDoc.createElement("one:T")
Set newTextNode = newTextNode.appendChild(newTextNodeElement)
' Add the text for the Page's content.
Dim newcd As MSXML2.IXMLDOMCDATASection
Set newcd = nDoc.createCDATASection(cNode.Text)
newTextNode.appendChild newcd
End If
Next
---------- For File Nodes -----------
For Each fNode In fNodes
'Set newFileNode = fNode
Set npNode = npNode.appendChild(fNode)
Next
onote.UpdatePageContent nDoc.XML, DateTime.Now, xs2013
End If
End If
End Sub
The onenote.UpdatePageContent continues to fail with a runtime error -2147213296 (80042010). The code works if i consider only text nodes, while if i add the code for File Nodes it doesn't work anymore.
I tried to change the code for File Nodes with this code:
For Each fNode In fNodes
Dim newFileNodeElement As MSXML2.IXMLDOMElement
Dim newFileNode As MSXML2.IXMLDOMNode
'Set newFileNode = fNode
'Set npNode = npNode.appendChild(fNode)
Set newFileNodeElement = nDoc.createElement("one:InsertedFile")
Set newFileNode = npNode.appendChild(newFileNodeElement)
For i = 0 To fNode.Attributes.Length - 1
Dim attrName As String
Dim attrValue As String
Dim attr As MSXML2.IXMLDOMAttribute
Dim namedNodeMap As MSXML2.IXMLDOMNamedNodeMap
attrName = fNode.Attributes(i).nodeName
attrValue = fNode.Attributes(i).NodeValue
Set attr = nDoc.createNode(2, attrName, "")
attr.Value = attrValue
Set namedNodeMap = nDoc.DocumentElement.LastChild.Attributes
Set newFileNode = namedNodeMap.setNamedItem(attr)
Next i
Next
but the results are the same.
OneNote error codes are listed here, so that error is "The last modified date does not match. ".
The second argument to UpdatePageContent is:
dateExpectedLastModified – (Optional) The date and time that you think
the page you want to update was last modified. If you pass a non-zero
value for this parameter, OneNote proceeds with the update only if the
value you pass matches the actual date and time the page was last
modified. Passing a value for this parameter helps prevent
accidentally overwriting edits users made since the last time the page
was modified.
Remove the DateTime.Now argument (omit it), if you don't need it, or correct the value. It is an additional check parameter, not a date-stamp.
I solved this issue using a different approach: i used Publish method in order to create a new section with the name of the page i needed to copy, and the MergeSections method to copy the page in the section i wished. Here is the code:
Private Sub CreateInNewSection(onote As onenote.Application, pageXML As String,
newSecId As String, title As String, nbID As String, path As String)
Dim pDoc As MSXML2.DOMDocument60
Set pDoc = New MSXML2.DOMDocument60
If pDoc.LoadXML(pageXML) Then
Dim pNode As MSXML2.IXMLDOMNode
soapNS = "xmlns:one='http://schemas.microsoft.com/office/onenote/2013/onenote'"
pDoc.setProperty "SelectionNamespaces", soapNS
Set pNode = pDoc.SelectSingleNode("//one:Page")
Dim oldPageId As String
Dim oldPageName As String
oldPageId = pNode.Attributes.getNamedItem("ID").Text
oldPageName = pNode.Attributes.getNamedItem("name").Text
path = path + "\" + oldPageName + ".one"
Debug.Print path
onote.Publish oldPageId, path, pfOneNote, ""
Dim sXml As String
onote.GetHierarchy nbID, hsSections, sXml, xs2013
Dim sDoc As MSXML2.DOMDocument60
Set sDoc = New MSXML2.DOMDocument60
Dim nowSecId As String
If sDoc.LoadXML(sXml) Then
' select the Section nodes
Dim sNodes As MSXML2.IXMLDOMNodeList
soapNS = "xmlns:one='http://schemas.microsoft.com/office/onenote/2013/onenote'"
sDoc.setProperty "SelectionNamespaces", soapNS
Set sNodes = sDoc.DocumentElement.SelectNodes("//one:Section")
Dim j As Integer
If Not sNodes Is Nothing Then
' Get the first section.
Dim sNode As MSXML2.IXMLDOMNode
For j = 0 To (sNodes.Length - 1)
If sNodes(j).Attributes.getNamedItem("name").Text = oldPageName Then
nowSecId = sNodes(j).Attributes.getNamedItem("ID").Text
Exit For
End If
Next j
End If
onote.MergeSections nowSecId, newSecId
onote.DeleteHierarchy nowSecId
onote.DeleteHierarchy oldPageId
End If
End If
End Sub
I'm getting said error in using VBA in Excel on the following code:
Private Sub XMLGen(mapRangeA, mapRangeB, ticketSize, mapping)
Dim fieldOneArr As Variant
Dim fieldTwoArr As Variant
Dim row As Long
Dim column As Long
Dim infoCol As Long
Dim endInfo As Long
Dim objDom As DOMDocument
Dim objNode As IXMLDOMNode
Dim objXMLRootelement As IXMLDOMElement
Dim objXMLelement As IXMLDOMElement
Dim objXMLattr As IXMLDOMAttribute
Set ws = Worksheets("StockData")
Dim wsName As String
Set objDom = New DOMDocument
If ticketSize = 8 Then
wsName = "A7Tickets"
ElseIf ticketSize = 16 Then
wsName = "A8Tickets"
Else
wsName = "A5Tickets"
End If
Set ps = Worksheets(wsName)
'create processing instruction
Set objNode = objDom.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
objDom.appendChild objNode
'create root element
Set objXMLRootelement = objDom.createElement("fields")
objDom.appendChild objXMLRootelement
'create Attribute to the Field Element and set value
Set objXMLattr = objDom.createAttribute("xmlns:xfdf")
objXMLattr.NodeValue = "http://ns.adobe.com/xfdf-transition/"
objXMLRootelement.setAttributeNode objXMLattr
infoCol = 1
fieldOneArr = Worksheets(mapping).range(mapRangeA)
fieldTwoArr = Worksheets(mapping).range(mapRangeB)
For row = 1 To UBound(fieldOneArr, 1)
For column = 1 To UBound(fieldOneArr, 2)
'create Heading element
Set objXMLelement = objDom.createElement(fieldOneArr(row, column))
objXMLRootelement.appendChild objXMLelement
'create Attribute to the Heading Element and set value
Set objXMLattr = objDom.createAttribute("xfdf:original")
objXMLattr.NodeValue = (fieldTwoArr(row, column))
objXMLelement.setAttributeNode objXMLattr
objXMLelement.Text = ps.Cells(row, infoCol)
infoCol = infoCol + 1
endInfo = endInfo + 1
If endInfo = 4 Then
infoCol = 1
End If
Next column
Next row
'save XML data to a file
If ticketSize = 2 Then
objDom.Save ("C:\ExportTestA5.xml")
MsgBox "A5 XML created"
ElseIf ticketSize = 8 Then
objDom.Save ("C:\ExportTestA7.xml")
MsgBox "A7 XML created"
Else
objDom.Save ("C:\ExportTestA8.xml")
MsgBox "A8 XML created"
End If
End Sub
When I hit debug it points to this line:
fieldOneArr = Worksheets(mapping).range(mapRangeA)
I know that .Range is supposed to be upper case but it keeps on setting it to lower case automatically whenever I correct it.
This code is meant to create an XML file and then write the details from the chosen worksheet (based on the ticketSize variable) into the correct XML fields. Hence I have a mapping worksheet from which I write the field and attribute names, and then write in the info from the correct ticket size worksheet into the text property of the element.
You should define the types of your function parameters, in this case mapRangeA As String. Office object methods and properties are often not very helpful with their error messages, so it's better to have a type mismatch error if you have a problem with a parameter.