Unable to extract value for xml tags - excel

I am a new to vba and have a task to do at hand. I have written some unction but could not debug it properly. I have following string in xml format:
<!--?xml version=""1.0"" encoding=""UTF-8""?-->
<credentials>
<mid>P</mid>
<mpid>Q</mpid>
<accid>R</accid>
<accesskey>S</accesskey>
<secretkey>T</secretkey>
</credentials>
and am trying to extract value corresponding to tag mid, mpid, accid etc.
Here is the subroutine I wrote:
Private Sub ExtractMWSCredentials(Text As String
Set xmldoc = Nothing
DoEvents
Set xmldoc = Get_XML_DOMDocument_Object()
xmldoc.LoadXML (Trim(Text))
Set mId = xmldoc.getElementsByTagName("mid").Item(0).Text
Set mpId = xmldoc.getElementsByTagName("mpid").Item(0).Text
Set accid = xmldoc.getElementsByTagName("accid").Item(0).Text
Set accesskey = xmldoc.getElementsByTagName("accesskey").Item(0).Text
End Sub
Everything is coming out to be empty. Any help appreciated.

I can't even get that code to compile. You don't use the Set keyword to store a non-object value like Text. You could code, for instance,
Set omId = xmldoc.getElementsByTagName("mid").Item(0)
Debug.Print omId.Text
Also, mId is a reserved word so it can't be a variable name. Here's one way you could do it.
Public Sub Extract()
Dim xDoc As MSXML2.DOMDocument60
Dim sMid As String, sMpid As String
Dim sAccid As String, sAccessKey As String
Set xDoc = New MSXML2.DOMDocument60
xDoc.LoadXML "<!--?xml version=""1.0"" encoding=""UTF-8""?-->" & _
"<credentials><mid>P</mid><mpid>Q</mpid><accid>R</accid>" & _
"<accesskey>S</accesskey><secretkey>T</secretkey></credentials>"
sMid = xDoc.getElementsByTagName("mid").Item(0).Text
sMpid = xDoc.getElementsByTagName("mpid").Item(0).Text
sAccid = xDoc.getElementsByTagName("accid").Item(0).Text
sAccessKey = xDoc.getElementsByTagName("accesskey").Item(0).Text
Debug.Print sMid, sMpid, sAccid, sAccessKey
End Sub
I don't use Set because I'm not storing the Item() in a variable, I'm storing the Item().Text in a variable.

Related

Edit XML through Excel VBA

I need to update a "simple" XML file with new values and save with a new name.
For a test I am only trying to update one value.
But using the code below I get an error:
Run-time error '91': Object variable or With block variable not set
VBA:
Sub XMLTest()
Dim myVar As String, pathToXML As String
Dim xmlDoc As Object, xmlRoot As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
pathToXML = "C:\Users\Path_to_XML\PJMeasurements.xml" '<--- Update path
Call xmlDoc.Load(pathToXML)
Set xmlRoot = xmlDoc.getElementsByTagName("ns0:MeasurementsSO").Item(0) '<--- Is this correct?
myVar = "9999-9999999" '<--- Update value
xmlRoot.SelectSingleNode("SalesOrderNo").Text = myVar
Call xmlDoc.Save(pathToXML)
End Sub
This is the XML:
<ns0:MeasurementsSO xmlns:ns0="http://update.DocumentTypes.Schema.PJ Measurement.Xml">
<SalesOrderNo>23482-4612310</SalesOrderNo>
<Weight>83</Weight>
<Volume>0,03</Volume>
<Numberofcolli>1</Numberofcolli>
</ns0:MeasurementsSO>
You need to add namespace:
Sub XMLTest()
Dim myVar As String, pathToXML As String
Dim xmlDoc As Object, xmlNode As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
pathToXML = "C:\Temp\PJMeasurements.xml" '<--- Update path
xmlDoc.setProperty "SelectionNamespaces", "xmlns:ns0='http://update.DocumentTypes.Schema.PJMeasurement.Xml'"
Call xmlDoc.Load(pathToXML)
Set xmlNode = xmlDoc.SelectSingleNode("/ns0:MeasurementsSO/SalesOrderNo")
myVar = "9999-9999999" '<--- Update value
xmlNode.Text = myVar
Call xmlDoc.Save(pathToXML)
End Sub
Found the error my self.
GetElementsByTagName was wrong.
Updated above.

Attribute Goes Into All Elements

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>

VBA Macro, get URL from given range loop and pull XML node

I have this code that is set up to get data ZIP code (single node) from an XML URL. However, I actually have a list of URLs in Sheet1, Column B that I need to loop through until all the data is extracted.
I dont want to have to update the code each time individually per URL. There are thousands... How would i be able to do that?
Here's an example of a working code for a single URL:
Sub test1()
Dim xmlDocument As MSXML2.DOMDocument60
Dim URL As String
Dim node As Object
Set xmlDocument = New DOMDocument60
URL = Sheets("Sheet1").Range("b2").Value
'Open XML page
Set xmlDocument = New MSXML2.DOMDocument60
xmlDocument.async = False
xmlDocument.validateOnParse = False
xmlDocument.Load URL
Dim nodeId As IXMLDOMNode
Dim nodeId2 As IXMLDOMNode
Set nodeId = xmlDocument.SelectSingleNode("/ZipCodeLookupResponse/Address/Zip5")
Set nodeId2 = xmlDocument.SelectSingleNode("/ZipCodeLookupResponse/Address/Zip4")
If Not nodeId Is Nothing Then
Sheets("fy2016").Range("e2").Value = nodeId.Text & " " & nodeId2.Text
Else
Sheets("fy2016").Range("e2").Value = "'ZIP code' was not found."
End If
End Sub
Assuming your code works you want something like a For Loop over all the urls. Move your document outside of the loop and load it inside the loop. I use an array to store the urls read in from the sheet for faster handling. Your construct wasn't handling any errors on parse so I have commented out related lines.
Not tested.
Option Explicit
Public Sub test1()
Dim xmlDocument As MSXML2.DOMDocument60, URLs(), i As Long
Dim node As Object, nodeId As IXMLDOMNode, nodeId2 As IXMLDOMNode
Set xmlDocument = New DOMDocument60
URLs = ThisWorkbook.Worksheets("Sheet1").Range("B2:B1000").Value
Set xmlDocument = New MSXML2.DOMDocument60
xmlDocument.async = False
' xmlDocument.validateOnParse = False
For i = LBound(URLs, 1) To UBound(URLs, 1)
xmlDocument.Load URLs(i, 1)
Set nodeId = xmlDocument.SelectSingleNode("/ZipCodeLookupResponse/Address/Zip5")
Set nodeId2 = xmlDocument.SelectSingleNode("/ZipCodeLookupResponse/Address/Zip4")
If Not nodeId Is Nothing Then
ThisWorkbook.Worksheets("fy2016").Cells(i + 1, "E").Value = nodeId.Text & " " & nodeId2.Text
Else
ThisWorkbook.Worksheets("fy2016").Cells(i + 1, "E").Value = "'ZIP code' was not found."
End If
Set nodeId = Nothing: Set nodeId2 = Nothing
Next
End Sub

Object.Namespace path error

I wrote this code to return some properties from file:
Dim strMTitle As String
Dim objMshell As Object
Dim objMfolder As Object
Dim objMFolderItem As Object
Dim strMpath As String
strMpath = "C:\Users\User1\Desktop\Test4\"
Set objMshell = CreateObject("shell.application")
Set objMfolder = objMshell.Namespace(strMpath)
Set objMFolderItem = objMfolder.ParseName("test2.xlsm")
strMTitle = objMfolder.GetDetailsOf(objMFolderItem, 21)
Debug.Print strMTitle
The problem is that it keeps returning run time error 91 - Object variable with block variable not set. Weirdest thing is that when I "Hardcode" objMfolder with path like this:
Set objMfolder = objMshell.Namespace("C:\Users\User1\Desktop\Test4\") the code works perferct.
I use this path in multiple places in my macro so I would really like to "store" it in strMpath and use it like this:
Set objMfolder = objMshell.Namespace(strMpath)
Please help!
The code seems to work with the string variable if you use early-binding and the Shell32.Shell as below. Also, .GetDetailsOf with a column argument of 21 returns nothing, but 0 returns the file name.
Option Explicit
'Set Reference to Microsoft Shell Controls and Automation
Sub dural()
Dim strMTitle As String
Dim objMshell As Shell32.Shell
Dim objMfolder As Folder
Dim objMFolderItem As FolderItem
Dim strMpath As String
strMpath = "C:\Users\Ron\Desktop\"
Set objMshell = New Shell32.Shell
Set objMfolder = objMshell.Namespace(strMpath)
Set objMFolderItem = objMfolder.ParseName("20161104.csv")
strMTitle = objMfolder.GetDetailsOf(objMFolderItem, 0)
Debug.Print strMTitle
End Sub

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