Reputation: 555
I have an XML file and this XML file has namespaces declared
<CrystalReport xmlns="urn:crystal-reports:schemas:report-detail" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:crystal-reports:schemas:report-detail http://www.businessobjects.com/products/xml/CR2008Schema.xsd">
This is causing problems in my VBA code in Excel. When I remove the namespaces of this line above, it works fine.
My question is: How can I ignore this namespace without have to open the xml file and remove manually?
The code I am using:
Public xmlDOM As MSXML2.DOMDocument60
Public Sub setXML(xmlFileName As String)
'Set xmlDOM = CreateObject("MSXML2.DOMDocument")
Set xmlDOM = New MSXML2.DOMDocument60
xmlDOM.async = False
xmlDOM.Load xmlFileName
End Sub
Public Function getNode(p_strNode As Variant) As Variant
Dim objNodes As IXMLDOMNodeList
Dim objNode As IXMLDOMNode
Dim storage As Variant
Dim X As Integer
Set objNodes = xmlDOM.SelectNodes(p_strNode)
Set getNode = objNodes
End Function
Public Sub SB_StartLoadClarityReport()
Dim d_path As String
Dim d_node As Variant
Dim d_arrayFields As Variant
d_path = F_GetPathXML()
'@Temp
d_path = Cells(1, 1).Value
'Open XML File
setXML (d_path)
'Get the project fields
Set d_node = getNode("CrystalReport/Details/Section")
d_arrayFields = F_GetProjectFields(d_node)
End Sub
Private Function F_GetProjectFields(p_strNode As Variant)
'Get the project fields
'Ex: <Field Name="PROJECTNAME1" - Get PROJECTNAME1
Dim d_arrayFields As Variant
Dim p_item As IXMLDOMElement
Dim d_count As Integer
d_count = 1
For Each p_item In p_strNode.Item(0).ChildNodes
If d_count = 1 Then
ReDim d_arrayFields(1 To d_count)
Else
ReDim Preserve d_arrayFields(1 To d_count)
End If
d_arrayFields(d_count) = p_item.Attributes.Item(0).Text
d_count = d_count + 1
Next p_item
F_GetProjectFields = d_arrayFields
End Function
Upvotes: 2
Views: 5421
Reputation: 191
I spent a few hours trying to find a proper solution that ignores any namespace, without having to set them in .setProperty "SelectionNamespaces"
, because I didn't want to change my .SelectNodes("//Test")
code to match every possible namespace !
The solution that worked for me requires using the method .transformNodeToObject
:
Public Sub fixNS(ByRef doc As DOMDocument60)
Dim fixNS0 As New DOMDocument60
fixNS0.LoadXML ("<xsl:stylesheet version='1.0' xmlns:xsl='http://www.w3.org/1999/XSL/Transform'>" & _
"<xsl:output method='xml' indent='yes' encoding='UTF-8' omit-xml-declaration='yes' />" & _
"<xsl:template match='comment()'> <xsl:copy/> </xsl:template>" & _
"<xsl:template match='*'>" & _
"<xsl:text>
</xsl:text>" & _
"<xsl:element name='{local-name(.)}'>" & _
"<xsl:apply-templates select='@* | node()'/>" & _
"</xsl:element>" & _
"<xsl:text>
</xsl:text>" & _
"</xsl:template> <xsl:template match='@*'>" & _
"<xsl:attribute name='{local-name(.)}'><xsl:value-of select='.'/></xsl:attribute>" & _
"</xsl:template> </xsl:stylesheet>")
doc.transformNodeToObject fixNS0, doc
End Sub
The provided xsl:stylesheet
removes all namespaces, while preserving attributes and also comments, but you can change it to remove them.
Now I'm using my initial code .SelectNodes("//Test")
without worrying about any namespace I load !
EDIT
After some research, I managed to modify the xsl:stylesheet to keep indentation, as the original code was just stacking elements one after another, so adding 2 Line Feed characters before and after the element tag (like <xsl:text>
</xsl:text>
) solved the issue.
Notes
A reference to Microsoft XML, v6.0
is required to use the code.
You can save the whole < xsl > code to an external file .xsl
and use the .load "file.xsl"
method instead, but I prefer it this way to be as much standalone as possible !
The resulting xml indentation is now like the original, but if you don't like the closing <tags></tags>
issue, you'll need to use this PrettyPrintXML function to get <tags/>
:
Public Function PrettyPrintXML(XML As String) As String
Dim Reader As New SAXXMLReader60, Writer As New MXXMLWriter60
Writer.indent = True: Writer.standalone = False
Writer.omitXMLDeclaration = True: Writer.Encoding = "utf-8"
Set Reader.contentHandler = Writer: Set Reader.dtdHandler = Writer
Set Reader.errorHandler = Writer
Call Reader.putProperty("http://xml.org/sax/properties/declaration-handler", Writer)
Call Reader.putProperty("http://xml.org/sax/properties/lexical-handler", Writer)
Call Reader.parse(XML) 'A document must contain exactly one root element
PrettyPrintXML = Writer.output
End Function
To check if a change is needed, you can verify that :
xmlDom.DocumentElement.NamespaceURI <> ""
Upvotes: 2
Reputation: 166980
This worked for me (after some amount of head-scratching)
Sub Tester()
Const XML As String = "<?xml version='1.0'?>" & _
"<CrystalReport xmlns='urn:crystal-reports:schemas:report-detail' " & _
" xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' " & _
" xsi:schemaLocation='urn:crystal-reports:schemas:report-detail " & _
" http://www.businessobjects.com/products/xml/CR2008Schema.xsd'>" & _
" <Test>Testing</Test>" & _
"</CrystalReport>"
Dim xmlDom As New MSXML2.DOMDocument60
Dim nodeList As MSXML2.IXMLDOMNodeList
Dim iNode As MSXML2.IXMLDOMNode
With xmlDom
.async = False
.validateOnParse = True
.LoadXML XML
.setProperty "SelectionLanguage", "XPath"
'set the default namespace and give it a prefix (e.g.) "xx"
.setProperty "SelectionNamespaces", _
"xmlns:xx='urn:crystal-reports:schemas:report-detail'"
'use the same default prefix in your XPath
Set nodeList = .SelectNodes("//xx:Test")
End With
Debug.Print nodeList.Length
For Each iNode In nodeList
Debug.Print iNode.XML
Next iNode
End Sub
Upvotes: 4