Remove the root tag of the XML but keep the contents inside it-CodePudding

I am using the below code to enable the user to select an XML file, and then the code deletes the <metadata> tag from the XML, and replaces it by the modified one;

Sub Button1_Click()
    Dim fso As Object, ts As Object, doc As Object
    Dim data As Object, filename As String
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    ' select file
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show <> -1 Then Exit Sub
        filename = .SelectedItems(1)
    End With
    
    ' read file and add top level
    Set doc = CreateObject("MSXML2.DOMDocument.6.0")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpentextFile(filename)
    doc.LoadXML Replace(ts.readall, "<metadata>", "<root><metadata>", 1, 1) & "</root>" '<metadata> removed
    ts.Close
    
    ' import data tag only
    Dim s As String
    Set data = doc.getElementsByTagName("data")(0)
    s = data.XML
    ' MsgBox s
    
    Set ts = fso.CreateTextFile(filename, True)
    ts.Write s
    ts.Close
    
    MsgBox s 'works perfectly
End Sub

The above code worked perfectly for me, when I was assigned to work with an XML like this -

But now, I have a different XML to deal with, which is like - (difference : the ajson root tag)

How do I delete the ajson opening and closing tags, so I get my desired result? Kindly guide... Thanks!

CodePudding user response：

Here is how to do it via XSLT transformation.

XSLT in VBA: Excel VBA Coding for xls transformation

Input XML

<?xml version="1.0"?>
<ajson:json xmlns:ajson="http://www.google.com">
    <metadata>
        <sample>Hi</sample>
    </metadata>
    <data>
        <catalog>
            <book id="bk101">
                <author>Gambardella, Matthew</author>
                <title>XML Developer's Guide</title>
            </book>
        </catalog>
    </data>
</ajson:json>

XSLT

<?xml version="1.0"?>
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform" xmlns:ajson="http://www.google.com">
    <xsl:output method="xml" encoding="utf-8" indent="yes" omit-xml-declaration="yes"/>
    <xsl:strip-space elements="*"/>

    <!-- template to copy without a namespace-->
    <xsl:template match="*">
        <xsl:element name="{local-name()}">
            <xsl:copy-of select="@*"/>
            <xsl:apply-templates/>
        </xsl:element>
    </xsl:template>

    <!-- template to remove document's root element -->
    <xsl:template match="/*">
        <xsl:apply-templates select="node()"/>
    </xsl:template>

    <xsl:template match="data" mode="copy-no-namespaces">
        <xsl:copy>
            <xsl:apply-templates select="@*|node()"/>
        </xsl:copy>
    </xsl:template>

    <xsl:template match="metadata">
    </xsl:template>
</xsl:stylesheet>

Output XML

<data>
  <catalog>
    <book id="bk101">
      <author>Gambardella, Matthew</author>
      <title>XML Developer's Guide</title>
    </book>
  </catalog>
</data>

CodePudding user response：

Since your XML format seems to be variable maybe a simple text processing script is all you need.

Option Explicit

Sub Button1_Click()
    Dim fso As Object, ts As Object, filename As String
    Dim s As String, sOut As String, bData As Boolean
    
    'select file
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show <> -1 Then Exit Sub
        filename = .SelectedItems(1)
    End With
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpentextFile(filename)
   
    ' capture between <data> .... </data>
    Do While ts.AtEndOfStream <> True
        s = ts.readline
        If Trim(s) = "<data>" Then bData = True
        If bData Then sOut = sOut & s & vbCrLf
        If Trim(s) = "</data>" Then bData = False
    Loop
    Set ts = fso.CreateTextFile(filename, True)
    ts.Write sOut
    ts.Close
    MsgBox sOut
    
End Sub