How to create an attribute with specific value if it doesn't exist - VBA - excel

Sorry for my bad English, but i'll try to describe my problem right. I have a code in VBA. Here it is:
Sub TestXML()
Dim doc As New DOMDocument
Const filePath As String = "D:\Test3.xml"
Dim isLoaded As Boolean
isLoaded = doc.Load(filePath)
If isLoaded Then
Dim oAttributes As MSXML2.IXMLDOMNodeList
Set oAttributes = doc.getElementsByTagName("Operation")
Dim attr As MSXML2.IXMLDOMAttribute
Dim node As MSXML2.IXMLDOMElement
Dim tdate As String
tdate = Format(Now(), "yyyy-mm-dd")
For Each node In oAttributes
For Each attr In node.Attributes
If attr.Name = "Client" Then
If attr.Value <> "UL" Then
attr.Value = "UL"
End If
ElseIf attr.Name = "Date" Then
If attr.Value <> "tdate" Then
attr.Value = tdate
End If
End If
Next attr
Next node
doc.Save filePath
End If
End Sub
Question is - How can i create attribute "Client" with value "UL" in element "Operation" only if it doesn't exist?
Here is a .xml file example with which i working:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<Document>
<Operations>
<Operation Date="2018-11-06" Client="UL"/>
<Operation Date="2018-11-06" Client="UL"/>
<Operation Date="2018-11-06"/>
</Operations>
</Document>
Thanks!

Try to read the attribute node, if it does not exist create it:
For Each node In oAttributes
If (node.getAttributeNode("Client") Is Nothing) Then
'// add missing attrib
node.setAttribute "Client", "UL"
End If
Your current code seems to want all elements to have Client=UL, to accomplish that simply:
For Each node In oAttributes
node.setAttribute "Client", "UL"
Next node
Which will overwrite or create the attribute as needed.

Related

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

Specific node in XML file use VBA

I want to replace data in a XML file using VBA. The XML data looks like this:
<MarkGrades>
<Grade MarkGrade="0" Label="3OP" TestBins="1,-1">0</Grade>
<Grade MarkGrade="2" Label="GOOD" TestBins="2">2</Grade <Grade>
<Grade MarkGrade="4" Label="FU" TestBins="31,3135,3136,3312,">4</Grade>
<Grade MarkGrade="3" Label="PA" TestBins="4016,4022,4029">3</Grade>
<Grade MarkGrade="5" Label="OS" TestBins="12,13,20012,20013">5</Grade>
</MarkGrades>
I want to replace data in node TestBins. If MarkGrade="4" or Label="FU" then replace data in TestBins from "2" to "something". But I can't seem to figure out how to specify that:
Dim doc As Object
Set doc = CreateObject("MSXML2.DOMDocument")
Dim isLoaded As Boolean
Dim i As Integer
Dim filePath As Variant
filePath = "C:\Users\xxxx\Desktop\Splitter\test.xml"
isLoaded = doc.Load(filePath)
i = 0
If isLoaded Then
Dim Grade As msxml2.IXMLDOMNodeList
Set Grade = doc.getElementsByTagName("Grade")
Dim attr As msxml2.IXMLDOMAttribute
Dim node As msxml2.IXMLDOMElement
For Each node In Grade
For Each attr In node.Attributes
If attr.Name = "TestBins" Then
i = i + 1
If i = 3 Then
attr.Value = SplitterMark.TextBox3.Value
ElseIf i = 4 Then
attr.Value = SplitterMark.TextBox4.Value
ElseIf i = 5 Then
attr.Value = SplitterMark.TextBox5.Value
End If
End If
Next attr
Next node
I tried to count if found TestBins count +1
That is working good. But can use with only this file because other file it is not common. like this:
<MarkGrades>
<Grade MarkGrade="5" Label="OS" TestBins="12,13,20012,20013">5</Grade>
<Grade MarkGrade="0" Label="3OP" TestBins="1,-1">0</Grade>
<Grade MarkGrade="4" Label="FU" TestBins="31,3135,3136,3312,">4</Grade>
<Grade MarkGrade="2" Label="GOOD" TestBins="2">2</Grade <Grade>
<Grade MarkGrade="3" Label="PA" TestBins="4016,4022,4029">3</Grade>
</MarkGrades>
Any ideas?
You could use xpath to identify the appropriate nodes and setAttribute for the value setting. You need to correct your xml though.
Option Explicit
Public Sub test()
Dim xmlDoc As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
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 elem As Object
For Each elem In xmlDoc.SelectNodes("//Grade[#MarkGrade='4' or #Label='FU' and #TestBins]")
elem.setAttribute "TestBins", "Banana"
Next
Debug.Print xmlDoc.XML
End Sub
Corrected xml line:
<Grade MarkGrade="2" Label="GOOD" TestBins="2">2</Grade>

VBA - Loop specific childnodes from XML code

I'm trying to scrape the following Xml into an Excel sheet. However, I only want to loop through specific childnodes to show the Name, PriceEffectiveStart, PriceEffectiveEnd, Price, and Currency for each index summary.
XML Code
<indexPrices>
<indexPriceSummary>
<id>1</id>
<uri>www.example.com</uri>
<index>
<id>3</id>
<name>Same Day Index</name>
<uri>www.example.com.xml</uri>
</index>
<priceEffectiveStart>2015-06-26</priceEffectiveStart>
<priceEffectiveEnd>2015-06-26</priceEffectiveEnd>
<price>
<amount>2.4806</amount>
<currency>CAD</currency>
</price>
<duration>1</duration>
<quantityTraded>
<amount>474</amount>
<unit>GJ</unit>
<contractUnit>Day</contractUnit>
</quantityTraded>
<numberOfTrades>7</numberOfTrades>
<settlementState>Settled</settlementState>
<lastUpdateDate>2015-06-27T02:15:01-06:00</lastUpdateDate>
</indexPriceSummary>
<indexPriceSummary>
<id>1</id>
<uri>www.example.com.xml</uri>
<index>
<id>1</id>
<name>Same Day Index </name>
<uri>www.example.com.xml</uri>
</index>
<priceEffectiveStart>2015-06-27</priceEffectiveStart>
<priceEffectiveEnd>2015-06-27</priceEffectiveEnd>
<price>
<amount>2.516</amount>
<currency>CAD</currency>
</price>
<duration>1</duration>
<quantityTraded>
<amount>251</amount>
<unit>GJ</unit>
<contractUnit>Day</contractUnit>
</quantityTraded>
<numberOfTrades>50</numberOfTrades>
<settlementState>Settled</settlementState>
<lastUpdateDate>2015-06-28T02:15:00-06:00</lastUpdateDate>
</indexPriceSummary>
</IndexPrices>
VBA Code
Dim xDoc As DOMDocument
Set xDoc = New DOMDocument
xDoc.LoadXML objHTTP.responseText
Dim i As Integer
Dim list As IXMLDOMNodeList
Set list = xDoc.SelectNodes("//indexPrices/indexPriceSummary")
Dim node As IXMLDOMNode
Dim childNode As IXMLDOMNode
Dim price As IXMLDOMNode
For Each node In list
i = i + 1
If (node.HasChildNodes) Then
For Each childNode In node.ChildNodes
i = i + 1
Debug.Print childNode.BaseName & " " & childNode.Text
Worksheets("Sheet1").Cells(i, 1) = childNode.BaseName
Worksheets("Sheet1").Cells(i, 2) = childNode.Text
Next childNode
End If
Next node
The current VBA shows all nodes in the output. I would like it to show only Name, PriceEffectiveStart, PriceEffectiveEnd, Price, and Currency for each index summary.
You can use xpath on each indexPriceSummary node to get at the child elements directly:
Sub Tester()
Dim xDoc As DOMDocument
Set xDoc = New DOMDocument
''more code here
xDoc.LoadXML objHTTP.responseText
Dim i As Integer
Dim list As IXMLDOMNodeList
Set list = xDoc.SelectNodes("//indexPrices/indexPriceSummary")
Dim node As IXMLDOMNode, nd As IXMLDOMNode
Dim childNode As IXMLDOMNode
Dim price As IXMLDOMNode
i = 4
For Each node In list
i = i + 1
With Sheet1.Rows(i)
.Cells(1).Value = GetNodeValue(node, "index/name")
.Cells(2).Value = GetNodeValue(node, "priceEffectiveStart")
.Cells(3).Value = GetNodeValue(node, "priceEffectiveEnd")
.Cells(4).Value = GetNodeValue(node, "price/amount")
.Cells(5).Value = GetNodeValue(node, "price/currency")
End With
Next node
End Sub
Function GetNodeValue(node As IXMLDOMNode, xp As String)
Dim n As IXMLDOMNode, nv
Set n = node.SelectSingleNode(xp)
If Not n Is Nothing Then nv = n.nodeTypedValue
GetNodeValue = nv
End Function

How to read XML attributes using VBA to Excel?

Here is my code..
<?xml version="1.0" ?>
<DTS:Executable xmlns:DTS="www.microsoft.com/abc" DTS:ExecutableType="xyz">
<DTS:Property DTS:Name="PackageFormatVersion">3</DTS:Property>
<DTS:Property DTS:Name="VersionComments" />
<DTS:Property DTS:Name="CreatorName">FirstUser</DTS:Property>
<DTS:Property DTS:Name="CreatorComputerName">MySystem</DTS:Property>
</DTS:Executable>
In this I am able to read Elements using "abc.baseName" and its value using "abc.Text".
It gives me result as
Property 3
Property
Property FirstUser
In this how can I read "PackageFormatVersion" as 3? i.e., I know some value is 3 but what that value is how could I know??
I mean I have to select which attribute I want to read.
Refer either to the element's .Text property or the .nodeTypeValue property :
Sub TestXML()
Dim xmlDoc As Object 'Or enable reference to Microsoft XML 6.0 and use: MSXML2.DOMDocument
Dim elements As Object
Dim el As Variant
Dim xml$
xml = "<?xml version=""1.0"" ?>"
xml = xml & "<DTS:Executable xmlns:DTS=""www.microsoft.com/abc"" DTS:ExecutableType=""xyz"">"
xml = xml & "<DTS:Property DTS:Name=""PackageFormatVersion"">3</DTS:Property>"
xml = xml & "<DTS:Property DTS:Name=""VersionComments"" />"
xml = xml & "<DTS:Property DTS:Name=""CreatorName"">FirstUser</DTS:Property>"
xml = xml & "<DTS:Property DTS:Name=""CreatorComputerName"">MySystem</DTS:Property>"
xml = xml & "</DTS:Executable>"
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
'## Use the LoadXML method to load a known XML string
xmlDoc.LoadXML xml
'## OR use the Load method to load xml string from a file location:
'xmlDoc.Load "C:\my_xml_filename.xml"
'## Get the elements matching the tag:
Set elements = xmlDoc.getElementsByTagName("DTS:Property")
'## Iterate over the elements and print their Text property
For Each el In elements
Debug.Print el.Text
'## Alternatively:
'Debug.Print el.nodeTypeValue
Next
End Sub
I know some value is 3 but what that value is how could I know??
You can review the objects in the Locals window, and examine their properties:
Here is an alternative, which seems clunkier to me than using the GetElementsByTagName but if you need to traverse the document, you could use something like this:
Sub TestXML2()
Dim xmlDoc As MSXML2.DOMDocument
Dim xmlNodes As MSXML2.IXMLDOMNodeList
Dim xNode As MSXML2.IXMLDOMNode
Dim cNode As MSXML2.IXMLDOMNode
Dim el As Variant
Dim xml$
xml = "<?xml version=""1.0"" ?>"
xml = xml & "<DTS:Executable xmlns:DTS=""www.microsoft.com/abc"" DTS:ExecutableType=""xyz"">"
xml = xml & "<DTS:Property DTS:Name=""PackageFormatVersion"">3</DTS:Property>"
xml = xml & "<DTS:Property DTS:Name=""VersionComments"" />"
xml = xml & "<DTS:Property DTS:Name=""CreatorName"">FirstUser</DTS:Property>"
xml = xml & "<DTS:Property DTS:Name=""CreatorComputerName"">MySystem</DTS:Property>"
xml = xml & "</DTS:Executable>"
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
'## Use the LoadXML method to load a known XML string
xmlDoc.LoadXML xml
'## OR use the Load method to load xml string from a file location:
'xmlDoc.Load "C:\my_xml_filename.xml"
'## Get the elements matching the tag:
Set xmlNodes = xmlDoc.ChildNodes
'## Iterate over the elements and print their Text property
For Each xNode In xmlDoc.ChildNodes
If xNode.NodeType = 1 Then ' only look at type=NODE_ELEMENT
For Each cNode In xNode.ChildNodes
Debug.Print cNode.nodeTypedValue
Debug.Print cNode.Text
Next
End If
Next
End Sub
Sub TestXML()
Set Reference to Microsoft XML 6.0
Dim Init As Integer
Dim xmlDoc As MSXML2.DOMDocument
Dim elements As Object
Dim el As Variant
Dim Prop As String
Dim NumberOfElements As Integer
Dim n As IXMLDOMNode
Init = 5
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
xmlDoc.Load ("C:\Users\Saashu\Testing.xml")
Set elements = xmlDoc.getElementsByTagName("DTS:Property")
Prop = xmlDoc.SelectSingleNode("//DTS:Property").Attributes.getNamedItem("DTS:Name").Text
NumberOfElements = xmlDoc.getElementsByTagName("DTS:Property").Length
For Each n In xmlDoc.SelectNodes("//DTS:Property")
Prop = n.Attributes.getNamedItem("DTS:Name").Text
Prop = Prop & " :: " & n.Text
ActiveSheet.Cells(Init, 9).Value = Prop
Init = Init + 1
Next
End Sub
This code still needs refinement as my requirement is to display only some of those attributes like CreatorName and CreatorComputerName,not all.
Thanks to David,for helping me in this issue.

Resources