Untitled

Option Explicit

Dim XmlFileName: XmlFileName = "D:\extract_column_test.xml"

Dim xmlDoc: Set xmlDoc=CreateObject("Microsoft.XMLDOM")
Dim Result

xmlDoc.async="false"
xmlDoc.setProperty "SelectionLanguage", "XPath"
Result = xmlDoc.load(XmlFileName)
If Not Result Then
        MsgBox("Error loading file """ & XmlFileName & """")
Else


        Dim nodes
        Dim column_record

        Set nodes = xmlDoc.selectNodes("//Collection[@Name='Columns']/SubRecord[child::Property[@Name='XXEXTRACTED_COLUMNXX']]")

        For Each column_record In nodes
                replaceColumn column_record
        End


        xmlDoc.save XmlFileName & ".new"
End If


Private Function replaceColumn(byRef column_record)
        Dim new_column1
        Dim new_column2
        Dim derivation_node


        Set new_column1 = column_record.copy
        new_column1.selectSingleNode("/Property[@Name='Name']").text = "NEW_COLUMN1"

        Set derivation_node = new_column1.selectSingleNode("/Propery[@Name='parsedDerivation']")
        derivation_node.text = Replace(derivation_node.text,"XXEXTRACTED_COLUMNXX","NEW_COLUMN1")

        Set derivation_node = new_column1.selectSingleNode("/Propery[@Name='SourceColumn']")
        derivation_node.text = Replace(derivation_node.text,"XXEXTRACTED_COLUMNXX","NEW_COLUMN1")


        Set new_column2 = column_record.copy
        new_column2.selectSingleNode("/Property[@Name='Name']").text = "NEW_COLUMN2"

        Set derivation_node = new_column1.selectSingleNode("/Propery[@Name='parsedDerivation']")
        derivation_node.text = Replace(derivation_node.text,"XXEXTRACTED_COLUMNXX","NEW_COLUMN2")

        Set derivation_node = new_column1.selectSingleNode("/Propery[@Name='SourceColumn']")
        derivation_node.text = Replace(derivation_node.text,"XXEXTRACTED_COLUMNXX","NEW_COLUMN2")


        column_record.appendSibling new_column1
        column_record.appendSibling new_column2
        column_record.delete

End Function