关于XML导入TREEVIEW,TREEVIEW导出XML的问题,已实现但有问题请教
XML导入TREEVIEW
'打开Private Sub btnOpen_Click() '打开文件选择窗体 CommonDialog1.Filter = "*.xml|*.xml" CommonDialog1.FilterIndex = 2 CommonDialog1.ShowOpen LoadTreeView (CommonDialog1.FileName)End SubSub LoadTreeView(ByVal ipath As String) If ipath = "" Then Exit Sub Else path = ipath End If Dim objDOM As DOMDocument Set objDOM = New DOMDocument '加载XML文件 Call objDOM.Load(path) 'Call objDom.loadXML("<Doc><Node1></Node1><Node2><ChildNode/></Node2></Doc>") '清空树 TreeView1.Nodes.Clear cmbURL.Text = path frmMain.Caption = title & " - " & path '给COMBOX增加打开文档的历史记录 Dim flag As Boolean flag = True Dim i For i = 0 To cmbURL.ListCount - 1 If cmbURL.List(i) = path Then flag = False Exit For End If Next If flag Then cmbURL.AddItem path, cmbURL.ListCount End If Call XmlToTree(objDOM.documentElement, Nothing) Set objDOM = NothingEnd Sub'从xml导入到树Sub XmlToTree(ByRef XMLNode As IXMLDOMNode, ByRef TreeNode As Node) Dim objNode As Node Dim xmlNodeList As IXMLDOMNodeList Dim lngNodeIndex As Long On Error GoTo ERR_HANDLER If TreeNode Is Nothing Then Set objNode = TreeView1.Nodes.Add Else Set objNode = TreeView1.Nodes.Add(TreeNode, tvwChild) End If If XMLNode.nodeName = "#text" Then objNode.Text = XMLNode.nodeValue Else objNode.Text = XMLNode.nodeName End If '展开节点-True 关闭节点-False If TreeNode Is Nothing Then objNode.Expanded = True Else objNode.Expanded = False End If Set xmlNodeList = XMLNode.childNodes For lngNodeIndex = 0 To xmlNodeList.length - 1 Call XmlToTree(xmlNodeList.Item(lngNodeIndex), objNode) NextERR_HANDLER: If Err.Number <> 0 Then MsgBox Err.Description End IfEnd Sub'保存Private Sub btnSave_Click() If MsgBox("确定保存数据？", vbYesNo, "请选择：") = vbYes Then Dim nd As Node ' For Each nd In TreeView1.Nodes' MsgBox nd.Text & nd.Tag & nd.Key'' Next Call LoadXML End IfEnd SubSub LoadXML() Dim objDOM As DOMDocument Dim root As IXMLDOMElement Set objDOM = New DOMDocument Set root = objDOM.createElement(TreeView1.Nodes(1).Text) Set objDOM.documentElement = root Set root = Nothing objDOM.preserveWhiteSpace = True Call TreeToXml(TreeView1.Nodes(1), objDOM.documentElement, True) objDOM.save (path) Set objDOM = NothingEnd Sub'从树导出到xmlPrivate Sub TreeToXml(ByRef TreeNode As Node, ByRef XMLNode As IXMLDOMNode, ByVal flag As Boolean) If flag Then End If Dim objNewNode As IXMLDOMNode Dim objDOM As DOMDocument Dim objChildNode As Node On Error GoTo ERR_HANDLER Set objDOM = XMLNode.ownerDocument If objDOM Is Nothing Then Set objDOM = XMLNode End If '如果flag=true,不给DOM对象加载主节点,如果falg=false则正常处理 If Not flag Then Set objNewNode = objDOM.createElement(TreeNode.Text) Call XMLNode.appendChild(objNewNode) Else Set objNewNode = objDOM.getElementsByTagName(TreeNode.Text)(0) ' Set objNewNode = objDOM.documentElement End If If TreeNode.Children > 0 Then Set objChildNode = TreeNode.Child Do Until objChildNode Is Nothing Call TreeToXml(objChildNode, objNewNode, False) Set objChildNode = objChildNode.Next Loop End If ERR_HANDLER: If Err.Number <> 0 Then MsgBox Err.Description End IfEnd Sub
<?xml version="1.0" encoding="gb2312" ?><A> <B> <NODE1>sdsf</NODE1> <NODE2>sdfsdf</NODE2> <NODE3>sdfsdf</NODE3> <NODE4>sdfdsf</NODE4> <NODE5>asdasd</NODE5> <NODE6>fgfhfgh</NODE6> </B> <C> <NODE1>asd</NODE1> <NODE2>asd</NODE2> <NODE3>teaxt</NODE3> <NODE4>dggg</NODE4> <NODE5>teaxt</NODE5> <NODE6>F4234</NODE6> </C></A>
<A><B><NODE1><AAA/></NODE1><NODE2><sdfsdf/></NODE2><NODE3><sdfsdf/></NODE3><NODE4><sdfdsf/></NODE4><NODE5><asdasd/></NODE5><NODE6><fgfhfgh/></NODE6></B><C><NODE1><asd/></NODE1><NODE2><asd/></NODE2><NODE3><teaxt/></NODE3><NODE4><dggg/></NODE4><NODE5><teaxt/></NODE5><NODE6><F4234/></NODE6></C></A>