How to delete a tag from imported XML through VBA (MS Excel)?-CodePudding

I am trying to do XML Mapping in my workbook, and I am supposed to work with this XML (given below) which the user would import from here -

<?xml version="1.0"?>
<metadata>
    <sample>Hi</sample>
<metadata>

<data>
    <main>
    ...
    </main>
</data>

XMLs can have only one root tag and the above one has two - metadata & data - so I must delete one of the root tags, in order to make the XML valid. I would like to delete the metadata root tag and keep the data tag. So, after the editing my XML should look like :

<?xml version="1.0"?>
<data>
    <main>
    ...
    </main>
</data>

Is it possible to edit an imported XML through Excel VBA?

Editing the XML as text won't work for me because I will be sharing the excel file with others and they wouldn't have the capability to edit the XML they are importing. That's why I am looking if I just import the XML, and VBA edits it for me...

CodePudding user response：

Add a top level to create valid XML and then select the node you want.

Option Explicit

Sub ImportXML()

    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 doc.LoadXML Replace(ts.readall, "<metadata>", "<root><metadata>", 1, 1) & "</root>"
    ts.Close
    
    ' import data tag only
    Dim s as string
    Set data = doc.getElementsByTagName("data")(0)
    s = data.XML
    MsgBox s
    'ActiveWorkbook.XmlImportXml data.XML, ImportMap _
    '   :=Nothing, Overwrite:=True, Destination:=ws.Range("$A$1")
    
    ' show maps
    'Dim msg As String, mp As XmlMap
    'For Each mp In ThisWorkbook.XmlMaps
    '    msg = vbLf & mp.Name & " - " & mp.RootElementName
    'Next
    'MsgBox "XML Maps" & msg
    
End Sub