Para finalizar a série XML e VB, vamos usar os componentes Microsoft XML, version 2.0 e TreeView.

Para este exemplo precisaremos de um arquivo XML com formato diferente do que usamos com ADO, e um arquivo DTD. Clique aqui para baixar os arquivos XML e DTD.

No Visual Basic crie um novo Projeto com nome de VBXML, renomeie o Form1 para frmXML.

Não esqueçam de fazer referência ao Microsoft XML, version 2.0, como mostra a figura abaixo:

Voltando ao form frmXML modele-o como mostra a figura abaixo:

Para incluir um TreeView, no menu principal clique em Project/Components e selecione o item Microsoft Windows Common Controls 6.0 (SP6), como mostra a figura abaixo:

Na barra de componente, dê um duplo clique em TreeView, como mostra a figura abaixo:

Selecione o TreeView que acabou de inserir, vá em properties renomeie para treeAgenda, como mostra a figura abaixo:

Agora clique em Custom, e configure as propriedades, como mostra a figura abaixo:

Codifique o frmXML da seguinte forma:

Option Explicit
Private m_objDOMPessoa As DOMDocument
Private m_blnItemClicked As Boolean
Private m_strXmlPath As String
Dim flagpreenche As Boolean

Private Sub Form_Load()
cmdSalvar.Enabled = False
m_strXmlPath = App.Path & "agenda.xml"
Call Preencher
End Sub

Private Sub cmdIncluir_Click()
cmdIncluir.Enabled = False
Call limpar
cmdSalvar.Enabled = True
End Sub

Private Sub cmdSalvar_Click()
cmdSalvar.Enabled = False
salvarNovaPessoa
Call limpar
cmdIncluir.Enabled = True
End Sub

Private Sub cmdExcluir_Click()
deleteSelectedPerson treeAgenda.SelectedItem
Call limpar
End Sub

Private Sub treeAgenda_Click()
Dim objSelNode As Node

If m_blnItemClicked = True Then
m_blnItemClicked = False
Exit Sub
End If

Set objSelNode = treeAgenda.SelectedItem
PreencherCampos objSelNode
End Sub

Private Sub cmdSair_Click()
Unload Me
End Sub

Private Sub PreencherCampos(objSelNode As Node)
Dim objPessoaElement As IXMLDOMElement
Dim objChildElement As IXMLDOMElement

'ignora a selecao do TreeView se não foi clicado
If objSelNode Is Nothing Then Exit Sub

If Trim(objSelNode.Tag) <> "" Then
'obtém o no(element type), que possui um atributo ao valor
'da tag do TreeView
Set objPessoaElement = m_objDOMPessoa.nodeFromID(objSelNode.Tag)

'varre os nós do treeView e preenche os campos
For Each objChildElement In objPessoaElement.childNodes
'verifica o tipo de No que estamos tratando
If objChildElement.nodeType = NODE_ELEMENT Then
Select Case UCase(objChildElement.nodeName)
Case "NOME"
txtNome.Text = objChildElement.nodeTypedValue
Case "ENDERECO"
txtEnd.Text = objChildElement.nodeTypedValue
Case "TELEFONE"
txtFone.Text = objChildElement.nodeTypedValue
Case "FAX"
txtFax.Text = objChildElement.nodeTypedValue
Case "EMAIL"
txtEmail.Text = objChildElement.nodeTypedValue
End Select
End If
Next objChildElement
End If

Set objChildElement = Nothing
Set objPessoaElement = Nothing
End Sub

Private Sub salvarNovaPessoa()
Dim objPerson As IXMLDOMElement
Dim objNewChild As IXMLDOMElement

'cria um novo elemento raíz (PESSOA)
Set objPerson = m_objDOMPessoa.createElement("PESSOA")
objPerson.setAttribute "PESSOAID", getNewID
m_objDOMPessoa.documentElement.appendChild objPerson

'cria um elemento filho (childNodes)
Set objNewChild = m_objDOMPessoa.createElement("NOME")
objNewChild.Text = txtNome.Text
objPerson.appendChild objNewChild

Set objNewChild = m_objDOMPessoa.createElement("ENDERECO")
objNewChild.Text = txtEnd.Text
objPerson.appendChild objNewChild

Set objNewChild = m_objDOMPessoa.createElement("TELEFONE")
objNewChild.Text = txtFone.Text
objPerson.appendChild objNewChild

Set objNewChild = m_objDOMPessoa.createElement("FAX")
objNewChild.Text = txtFax.Text
objPerson.appendChild objNewChild

Set objNewChild = m_objDOMPessoa.createElement("EMAIL")
objNewChild.Text = txtEmail.Text
objPerson.appendChild objNewChild

'sincroniza com o TreeView
PreencherComNovoNO objPerson

m_objDOMPessoa.Save m_strXmlPath

Set objPerson = Nothing
Set objNewChild = Nothing
End Sub
Private Function getNewID() As String
getNewID = "p" & m_objDOMPessoa.documentElement.childNodes.length + 1
End Function

Private Sub treeAgenda_Collapse(ByVal Node As MSComctlLib.Node)
PreencherCampos Node
m_blnItemClicked = True
End Sub

Private Sub treeAgenda_Expand(ByVal Node As MSComctlLib.Node)
PreencherCampos Node
m_blnItemClicked = True
End Sub

Private Sub Preencher()
Dim objPessoaRoot As IXMLDOMElement
Dim objPessoaElement As IXMLDOMElement
Dim tvwRoot As Node
Dim X As IXMLDOMNodeList

flagpreenche = True

Set m_objDOMPessoa = New DOMDocument

m_objDOMPessoa.resolveExternals = True
m_objDOMPessoa.validateOnParse = True

'carrega o XML no documento DOM
m_objDOMPessoa.async = False
Call m_objDOMPessoa.Load(m_strXmlPath)

'verifica se a carga do XML foi feita com sucesso
If m_objDOMPessoa.parseError.reason <> "" Then
MsgBox m_objDOMPessoa.parseError.reason
Exit Sub
End If

'obtém o elemento raíz do XML
Set objPessoaRoot = m_objDOMPessoa.documentElement

'define as propriedades do Treeview
treeAgenda.LineStyle = tvwRootLines
treeAgenda.Style = tvwTreelinesPlusMinusText
treeAgenda.Indentation = 400

'verifica se o treeview ja foi preenchido
'se ja foi remove o raiz que remove tudo
If treeAgenda.Nodes.Count > 0 Then
treeAgenda.Nodes.Remove 1
End If

' inclui um nó filho ao nó raiz do TreeView
Set tvwRoot = treeAgenda.Nodes.Add()
tvwRoot.Text = objPessoaRoot.baseName

' iteração através de cada elemento para encher a árvore
' que por sua vez interagem através de cada childNode
' do element(objPessoaElement)
For Each objPessoaElement In objPessoaRoot.childNodes
PreencherComNovoNO objPessoaElement
Next

cmdIncluir.Enabled = True
End Sub

Private Sub PreencherComNovoNO(objDOMNode As IXMLDOMElement)
Dim objNameNode As IXMLDOMNode
Dim objAttributes As IXMLDOMNamedNodeMap
Dim objAttributeNode As IXMLDOMNode
Dim objPessoaElement As IXMLDOMElement
Dim intIndex As Integer

Dim tvwElement As Node
Dim tvwChildElement As Node

'obtém o nome do elemento selecionado
Set objNameNode = objDOMNode.selectSingleNode("NOME")

'inclui os elementos aos nós
Set tvwElement = treeAgenda.Nodes.Add(1, tvwChild)
tvwElement.Text = objNameNode.parentNode.nodeName & ": " _
& objNameNode.nodeTypedValue

Set objAttributes = objDOMNode.Attributes

'verifica os atributos
If objAttributes.length > 0 Then
' obtendo o item para a referência 'PESSOAID',
' com NameNodeListMap para o Nó atual
Set objAttributeNode = objAttributes.getNamedItem("PESSOAID")

'armazena o valor na tag do treeview
tvwElement.Tag = objAttributeNode.nodeValue
End If

tvwElement.EnsureVisible
intIndex = tvwElement.Index

'interagem através dos Nós filhos(childNodes) do objeto DOMNode
' para preencher o TreeView os seus valores
For Each objPessoaElement In objDOMNode.childNodes
Set tvwChildElement = treeAgenda.Nodes.Add(intIndex, tvwChild)
tvwChildElement.Text = objPessoaElement.nodeTypedValue
Next
End Sub

Private Sub deleteSelectedPerson(objSelNode As Node)
Dim objPessoaElement As IXMLDOMNode
Dim objChildElement As IXMLDOMElement

'se não selecionou um nó na árvore sai
If objSelNode Is Nothing Then Exit Sub

'acha o nó atual no TreeView ou o seu Pai
' que possui um valor atribuido a tag
If Trim(objSelNode.Tag) = "" Then
If Trim(objSelNode.Parent.Tag) <> "" Then
Set objSelNode = objSelNode.Parent
End If
End If

If Trim(objSelNode.Tag) <> "" Then
Set objPessoaElement = m_objDOMPessoa.nodeFromID(objSelNode.Tag)
'remove o no do DOMDocument encontrado
m_objDOMPessoa.documentElement.removeChild objPessoaElement
m_objDOMPessoa.Save m_strXmlPath
treeAgenda.Nodes.Remove objSelNode.Index
End If
End Sub

Private Sub limpar()
txtNome.Text = ""
txtEnd.Text = ""
txtFone.Text = ""
txtFax.Text = ""
txtEmail.Text = ""
End Sub

Por enquanto é só pessoal. Um abraço a todos e até a semana que vem.