recorrer un xml usando DOMXMl de VBScript

[tammander]

Mira, te dejo una clase que hace, deshace, añade, crea, etc nodos y demas. La uso muy a menudo y funciona a la perfección. Al final hay un ejemplo de su uso. Echale un vistazo aunque el segundo enlace que te envié tiene un ejemplo más simple y el primero contiene TODAS las propiedades y métodos (DE OBLIGATORIO ESTUDIO)

Código:

Class objXML
  'strFile must be full path to document, ie C:\XML\XMLFile.XML
  'objDoc is the XML Object
  'Save to a file or not
  Private strFile, objDoc, mustSave

  '*********************************************************************
  ' Initialization/Termination
  '*********************************************************************

  'Initialize Class Members
  Private Sub Class_Initialize()
    strFile = ""
    mustSave = false
  End Sub

  'Terminate and unload all created objects
  Private Sub Class_Terminate()
    Set objDoc = Nothing
  End Sub

  '*********************************************************************
  ' Properties
  '*********************************************************************

  'Set XML File and objDoc
  Public Property Let File(str)
    Set objDoc = Server.CreateObject("Microsoft.XMLDOM")
    objDoc.async = False
    strFile = str
    objDoc.Load strFile
    if objDoc.parseError.errorCode <> 0 Then
        response.Write("Error de Lectura (Por favor, ponerse en contacto con el webmaster).<br />FilePos: " & objDoc.parseError.filepos & "<br /> Línea: " & objDoc.parseError.Line & "<br /> Causa: " & objDoc.parseError.reason & "<br /> Ocurrió en: " & objDoc.parseError.srcText & "<br /> Archivo: " & objDoc.parseError.URL)
        response.End()
    end if
  End Property

  'Get XML File
  Public Property Get File()
    File = strFile
  End Property

  'Set XML from a string
  Public Property Let fromStr(str)
    Set objDoc = Server.CreateObject("Microsoft.XMLDOM")
    objDoc.async = False
    
    objDoc.loadXML(strFile)
    if objDoc.parseError.errorCode <> 0 Then
        response.Write("Error de Lectura (Por favor, ponerse en contacto con el webmaster).<br />FilePos: " & objDoc.parseError.filepos & "<br /> Línea: " & objDoc.parseError.Line & "<br /> Causa: " & objDoc.parseError.reason & "<br /> Ocurrió en: " & objDoc.parseError.srcText & "<br /> Archivo: " & objDoc.parseError.URL)
        response.End()
    end if
  End Property

   ' return a string with the xml
  Public Property Get toString()
    toString = objDoc.xml
  End Property

  'save the XML document to a file or not
  Public Property Let SaveToFile(val)
    mustSave = val
  End Property
  
  '*********************************************************************
  ' Functions
  '*********************************************************************

  'Create Blank XML File, set current obj File to newly created file
  Public Function createFile(strPath, strRoot)
    Dim objFSO, objTextFile
    Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
    Set objTextFile = objFSO.CreateTextFile(strPath, True)
    objTextFile.WriteLine("<?xml version=""1.0""?>")
    objTextFile.WriteLine("<" & strRoot & "/>")
    objTextFile.Close
    Me.File = strPath
    Set objTextFile = Nothing
    Set objFSO = Nothing
  End Function

  'Get XML Field(s) based on XPath input from root node
  Public Function getField(strXPath)
    Dim objNodeList, arrResponse(), i
    Set objNodeList = objDoc.documentElement.selectNodes(strXPath)
    ReDim arrResponse(objNodeList.length)
    For i = 0 To objNodeList.length - 1
      arrResponse(i) = objNodeList.item(i).Text
    Next
    getField = arrResponse
  End Function

  'Update existing node(s) based on XPath specs
  Public Function updateField(strXPath, strData)
    Dim objField
    For Each objField In objDoc.documentElement.selectNodes(strXPath)
      objField.Text = strData
    Next
    if mustSave then objDoc.Save strFile
    Set objField = Nothing
    updateField = True
  End Function

  'Create node directly under root
  Public Function createRootChild(strNode)
    Dim objChild
    Set objChild = objDoc.createNode(1, strNode, "")
    objDoc.documentElement.appendChild(objChild)
    if mustSave then objDoc.Save strFile
    Set objChild = Nothing
  End Function

  'Create a child node under root node with attributes
  Public Function createRootNodeWAttr(strNode, attr, val)
    Dim objChild, objAttr
    Set objChild = objDoc.createNode(1, strNode, "")
    If IsArray(attr) And IsArray(val) Then
      If UBound(attr)-LBound(attr) <> UBound(val)-LBound(val) Then
        Exit Function
      Else
        Dim i
        For i = LBound(attr) To UBound(attr)
          Set objAttr = objDoc.createAttribute(attr(i))
          objChild.setAttribute attr(i), val(i)
        Next
      End If
    Else
      Set objAttr = objDoc.createAttribute(attr)
      objChild.setAttribute attr, val
    End If
    objDoc.documentElement.appendChild(objChild)
    if mustSave then objDoc.Save strFile
    Set objChild = Nothing
  End Function

  'Create a child node under the specified XPath Node
  Public Function createChildNode(strXPath, strNode)
    Dim objParent, objChild
    For Each objParent In objDoc.documentElement.selectNodes(strXPath)
      Set objChild = objDoc.createNode(1, strNode, "")
      objParent.appendChild(objChild)
    Next
    if mustSave then objDoc.Save strFile
    Set objParent = Nothing
    Set objChild = Nothing
  End Function

  'Create a child node(s) under the specified XPath Node with attributes
  Public Function createChildNodeWAttr(strXPath, strNode, attr, val)
    Dim objParent, objChild, objAttr
    For Each objParent In objDoc.documentElement.selectNodes(strXPath)
      Set objChild = objDoc.createNode(1, strNode, "")
      If IsArray(attr) And IsArray(val) Then
        If UBound(attr)-LBound(attr) <> UBound(val)-LBound(val) Then
          Exit Function
        Else
          Dim i
          For i = LBound(attr) To UBound(attr)
            Set objAttr = objDoc.createAttribute(attr(i))
            objChild.SetAttribute attr(i), val(i)
          Next
        End If
      Else
        Set objAttr = objDoc.createAttribute(attr)
        objChild.setAttribute attr, val
      End If
      objParent.appendChild(objChild)
    Next
    if mustSave then objDoc.Save strFile
    Set objParent = Nothing
    Set objChild = Nothing
  End Function

  'Delete the node specified by the XPath
  Public Function deleteNode(strXPath)
    Dim objOld
    For Each objOld In objDoc.documentElement.selectNodes(strXPath)
      objDoc.documentElement.removeChild objOld
    Next
    if mustSave then objDoc.Save strFile
    Set objOld = Nothing
  End Function
  
  ' Añadir un nodo CDATA
  public function addCDATANode(strXPath, strNodde)
    Dim objParent, objChild
    For Each objParent In objDoc.documentElement.selectNodes(strXPath)
      Set objChild = objDoc.createCDATASection(strNode)
      objParent.appendChild(objChild)
    Next
    if mustSave then objDoc.Save strFile
    Set objParent = Nothing
    Set objChild = Nothing
  end function
End Class

' USE:
'===============
'Dim objXML, strPath, str
'Set objXML = New clsXML

'strPath = Server.MapPath(".") & "\New.xml"

'objXML.createFile strPath, "Root"
'Or If using an existing XML file:
'objXML.File = "C:\File.xml"

'objXML.createRootChild "Images"

'Here only one attribute is added to the Images/Image Node
'objXML.createChildNodeWAttr "Images", "Image", "id", "1"
'objXML.updateField "Images//Image[@id=1]", "super.gif"
'objXML.createRootNodeWAttr "Jobs", Array("Size", "Length", "Width"), _
'    Array(24, 31, 30)
'objXML.createRootNodeWAttr "Jobs", Array("Size", "Length", "Width"), _
'    Array(24, 30, 29)
'objXML.createRootNodeWAttr "Jobs", Array("Size", "Length", "Width"), _
'    Array(24, 31, 85)

'Notice that all three job nodes have size 24, all of those 
'nodes will be updated
'objXML.updateField "Jobs[@Size=24]", "24's"

'Notice that only two nodes have the specified XPath, hence 
'only two new child nodes will be added
'objXML.createChildNodeWAttr "Jobs[@Size=24 and @Length=31]", "Specs", _
'    Array("Wood", "Metal", "Color"), _
'    Array("Cedar", "Aluminum", "Green")
'
'It is always important to iterate through all of the nodes
'returned by this XPath query.
'For Each str In objXML.getField("Jobs[@Size=24]")
'    Response.Write(str & "<br>")
'Next
'Set objXML = Nothing

'Response.Redirect "New.xml"

Usa XPath para realizar busqueda.



Un saludo