CODEWITHSUNDEEP
vbaexcel
S6633d
S6633d

Reputation: 101

Search contents of node and delete parent node in xml file using vba

I have an xml file "sample.xml" which needs to modified. I have a list of around 300 strings in column A in my excel sheet and I need to open the XML file and search these strings (it will be the content of a child node) and if found i want to delete the parent node of it.

Here is my sample.xml , it huge file than what I had mentioned below, I have posted a part of it

<gera_it>
<input>
  <Servers>
    <Server>
      <Name>htp</Name>
      <link>1.2.56.89</link>
    </Server>
     <Server>
      <Name>wty</Name>
      <link>1.4.67.89</link>
    </Server>
    <Server>
      <Name>vnb</Name>
      <link>1.6.11.98</link>
    </Server>
    <Server>
      <Name>mnf</Name>
      <link>1.4.89.45</link>
    </Server>
    <Server>
      <Name>typ</Name>
      <link>1.2.44.60</link>
    </Server>
  </Servers>
  <config>
     <map>yes</map>
  </config>
</input>
</gera_it>

My excel sheet has data from around 300 rows of data in A column. These strings are the contents of <Name> </Name>. I have mentioned few of them below

wty
mnf
uyt
ifh

I want to search these strings in the sample.xml file and if the string is found, i want to delete <Server> </Server> i.e) the whole parent node of it.

Here is what I have till now

Const Frow As Long = 3
Const Lrow As Long = 206
Const Stringcol As String = "A"
Dim varStrings As Variant
Dim Fpath As String
Dim ws As Worksheet
Dim lngIndex As Long

Fpath = ThisWorkbook.Path & "\sample.xml"

Set XDoc = CreateObject("MSXML2.DOMDocument")
XDoc.async = False: XDoc.validateOnParse = False
XDoc.Load (Fpath)

Set ws = ActiveSheet

With ws
    ' Create the strings array from the given range value.
    varStrings = .Range(.Cells(Frow, Stringcol), .Cells(Lrow, Stringcol)).Value
    ' Transpose the strings array into a one dimentional array.
    varStrings = Application.WorksheetFunction.Transpose(varStrings)
End With

Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")

For lngIndex = LBound(varStrings) To UBound(varStrings)
    If Len(Trim$(varStrings(lngIndex))) > 0 Then
        String = varStrings(lngIndex)
        XPath = "//gera_it/input/Servers/Server[Name = '" & String & "']"
        'delete child nodes that matches array strings
        For Each Node In XDoc.SelectNodes(XPath)
            Node.ParentNode.Removechild (Node)
        Next
    Else
        'Do Nothing
    End If
Next

XDoc.Save ThisWorkbook.Path & "\sample.xml"

I am getting a empty sample.xml if i execute above, I am not sure where it goes wrong.

Could someone help me with it.

Upvotes: 0

Views: 904

Answers (1)

Ambie
Ambie

Reputation: 4977

First of all I think your query string is selecting the nodes named Name whereas you probably want to select the parent nodes named Server, as it is this node that you want to delete from the parent. In the code below I've given you some sample syntax to achieve this.

Secondly, I've parsed the entire query into one search string. In your sample data, then, the query looks like this:

//gera_it/input/Servers/Server[Name = 'wty' or 'mnf' or 'uyt' or 'ifh']

There's nothing to stop you selecting each node name separately if you prefer to go that route. You'd just loop through the codes array and call SelectNodes (and remove) on each value.

Dim xmlDoc As MSXML2.DOMDocument60
Dim nodes As MSXML2.IXMLDOMNodeList
Dim node As MSXML2.IXMLDOMNode
Dim rng As Range
Dim codes As Variant
Dim queryString As String
Dim filePath As String
Dim fileName As String


'Read the codes from column "A"
With Sheet1 'change to your sheet
    Set rng = .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
codes = Application.Transpose(rng.Value2)

'Create your query string
queryString = "//gera_it/input/Servers/Server[Name = '" & _
            Join(codes, "' or '") & "']"

'Load the xml document
filePath = "[your path]"
fileName = "[your filename]"
Set xmlDoc = New MSXML2.DOMDocument60
With xmlDoc
    .async = False
    .validateOnParse = False
    .Load (filePath & "\" & fileName)
End With

'Delete the Server nodes
Set nodes = xmlDoc.SelectNodes(queryString)
For Each node In nodes
    node.ParentNode.RemoveChild node
Next

Upvotes: 2

Related Questions