Как игнорировать пространство имен XML

У меня есть файл XML, и этот файл XML имеет объявленные пространства имен

<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">

Это вызывает проблемы в моем коде VBA в Excel. Когда я удаляю пространства имен этой строки выше, он работает нормально.

Мой вопрос: как я могу игнорировать это пространство имен без необходимости открывать XML-файл и удалять вручную?

Код, который я использую:

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
Источник

2 ответа

Решение

Это сработало для меня (после некоторого количества царапин головы)

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
Источник

Я потратил несколько часов, пытаясь найти подходящее решение, игнорирующее любое пространство имен, без необходимости его установки..setProperty "SelectionNamespaces", потому что я не хотел менять свой код, чтобы он соответствовал всем возможным пространствам имен!

Решение, которое сработало для меня, требует использования метода.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>&#xA;</xsl:text>" & _
        "<xsl:element name='{local-name(.)}'>" & _
            "<xsl:apply-templates select='@* | node()'/>" & _
        "</xsl:element>" & _
        "<xsl:text>&#xA;</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

Предоставленноеxsl:stylesheetудаляет все пространства имен, сохраняя при этом атрибуты и комментарии, но вы можете изменить его, чтобы удалить их. Теперь я использую свой исходный код.SelectNodes("//Test")не беспокоясь о загружаемом пространстве имен!

РЕДАКТИРОВАТЬ После некоторых исследований мне удалось изменить таблицу стилей xsl: чтобы сохранить отступы, поскольку исходный код просто складывал элементы один за другим, поэтому добавлял 2 символа перевода строки до и после тега элемента (например,<xsl:text>&#xA;</xsl:text>) решил проблему.

Примечания

  • Ссылка наMicrosoft XML, v6.0требуется для использования кода.

  • Вы можете сохранить весь код <xsl> во внешний файл..xslи используйте .load "file.xsl"вместо этого, но я предпочитаю, чтобы он был как можно более автономным!

  • Полученный отступ xml теперь похож на оригинал, но если вам не нравится закрывающий<tags></tags>проблема, вам нужно будет использовать эту функцию PrettyPrintXML , чтобы получить<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

  • Чтобы проверить, необходимы ли изменения, вы можете убедиться, что:xmlDom.DocumentElement.NamespaceURI <> ""

Источник
Другие вопросы по тегам