Classe XML

REF http://www.vbweb.com.br/dicas_visual.asp?Codigo=2256

.. classe para trabalhar com XML, espero q ajude. Na verdade, a classe serve mais para criar XML, sem ter q ficar dando um monte de comandos...

Class ClsXML
     Public Root
     Public XML
   
     Private PIs
   
     Sub NewXML(TagPai, versao)
       Set XML = CreateObject ("Msxml2.DOMDocument" & Versao)
       XML.Async = False
       Set Root = XML.CreateElement(TagPai)
       XML.AppendChild(Root)
     
       Set PIs = XML.CreateProcessingInstruction("xml", "version='1.0' encoding='ISO-8859-1'")
       XML.InsertBefore PIs, Root
     End Sub

     Function Open(Path, versao)
          Dim Result
       Set XML = CreateObject ("Msxml2.DOMDocument" & Versao)
       XML.Async = False
         
          Result = XML.Load(Path)
          if Result = true then
               Set Root = XML.DocumentElement
          end if
          Open = Result
     End Function

     Function CriaNodo(TagPai, Nome, Atributos, ValorAtributos,ValorNodo)
       Dim Nodo
       Dim Valor
       Set Nodo = XML.CreateElement(Nome)
       If TagPai Is Nothing Then
         XML.AppendChild(Nodo)
       Else
         TagPai.AppendChild(Nodo)
       End If
     
       If Isarray(Atributos)  And Isarray(ValorAtributos) Then
         NumAtributos = Ubound(Atributos)
         For i = 0 To NumAtributos
           Call Nodo.setAttribute(Atributos(i), ValorAtributos(i))
         Next
       End If
       If ValorNodo <> "" Then
         Set Valor = XML.CreateTextNode(ValorNodo)
         Nodo.AppendChild(Valor)
       End If
       Set CriaNodo = Nodo
       Set Nodo = Nothing
       Set Valor = Nothing
     End Function

     Function RemoveNodo(Expressao)
          Dim Nodo
         
          Set Nodo = Xml.GetElementsByTagName(Expressao)
          if not Nodo is nothing then
               Call Nodo.RemoveAll
               RemoveNodo = true
          else
               RemoveNodo = false
          end if
     End Function

     Sub Save (Caminho)
       Call XML.Save(Caminho)
     End Sub

End Class

Usando a Classe para criar um XML com a seguinte estrutura:


 
     Rodrigo
     Lotus Notes
 


Dim NomeAtributos(), ValorAtributos()
Set objXML = New ClsXML()

'O primeiro parâmetro é a Tag pai de todas, o segundo é a versão do MSXML q você quer usar
Call NewXML("teste", "")
Redim NomeAtributos(0), ValorAtributos(0)
NomeAtributos(0) = "nome"
ValorAtributos(0) = "Teste"
Set Tag1 = objXML.CriaNodo(objXML.root, "tag1", NomeAtributos, ValorAtributos, "")
Call objXML.CriaNodo(Tag1, "nome1", "", "", "Rodrigo")
Call objXML.CriaNodo(Tag1, "ferramenta", "", "", "Lotus Notes")

Call objXML.Save("teste")