将文档保存到XML中，并将保存在XML中的文档还原。

fan0217

这是个有趣的过程，使用前先引用xml


创建个类模块：DocAndXml

1. 
   
2. Private objDoc As DOMDocument
   
3. Public Sub DocToXml(strDocPath As String, strXmlPath As String)
   
4.     Dim objEle As IXMLDOMElement
   
5.     Dim objRoot As IXMLDOMElement
   
6.     Dim objNode As IXMLDOMNode
   
7.     objDoc.resolveExternals = True
   
8.    
   
9.     Set objNode = objDoc.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")
   
10.     Set objNode = objDoc.insertBefore(objNode, objDoc.childNodes.Item(0))
    
11.    
    
12.     Set objRoot = objDoc.createElement("root")
    
13.     Set objDoc.documentElement = objRoot
    
14.         objRoot.setAttribute "xmlns:dt", "urn:schemas-microsoft-com:datatypes"
    
15.     Set objNode = objDoc.createElement("document")
    
16.         objNode.text = GetFilename(strDocPath)
    
17.         objRoot.appendChild objNode
    
18.    
    
19.     Set objNode = objDoc.createElement("createDate")
    
20.         objRoot.appendChild objNode
    
21.         Set objEle = objNode
    
22.         objEle.nodeTypedValue = Format(Now, "yyyy-mm-dd hh:mm:ss")
    
23.       
    
24.     Set objNode = objDoc.createElement("data")
    
25.         objRoot.appendChild objNode
    
26.     Set objEle = objNode
    
27.         objEle.DataType = "bin.base64"
    
28.          
    
29.         objEle.nodeTypedValue = ReadBinData(strDocPath)
    
30.         objDoc.Save strXmlPath
    
31. End Sub
    
32. Private Function ReadBinData(ByVal strFileName As String) As Variant
    
33.     Dim lLen As Long
    
34.     Dim iFile As Integer
    
35.     Dim arrBytes() As Byte
    
36.     Dim lCount As Long
    
37.     Dim strOut As String
    
38.     iFile = FreeFile()
    
39.     Open strFileName For Binary Access Read As iFile
    
40.     lLen = FileLen(strFileName)
    
41.     ReDim arrBytes(lLen - 1)
    
42.     Get iFile, , arrBytes
    
43.     Close iFile
    
44.    
    
45.     ReadBinData = arrBytes
    
46. End Function
    
47. Private Sub WriteBinData(ByVal strFileName As String)
    
48.     Dim iFile As Integer
    
49.     Dim arrBuffer() As Byte
    
50.     Dim objNode As IXMLDOMNode
    
51.       
    
52.     If Not (objDoc Is Nothing) Then
    
53.         Set objNode = objDoc.documentElement.selectSingleNode("/root/data")
    
54.         arrBuffer = objNode.nodeTypedValue
    
55.                   
    
56.         iFile = FreeFile()
    
57.         Open strFileName For Binary Access Write As iFile
    
58.         Put iFile, , arrBuffer
    
59.         Close iFile
    
60.    
    
61.     End If
    
62. End Sub
    
63. Public Sub XmlToDoc(strDocPath As String, strXmlPath As String)
    
64.     If objDoc.Load(strXmlPath) Then
    
65.        WriteBinData strDocPath
    
66.     End If
    
67. End Sub
    
68. Private Function GetFilename(FilePath As String) As String
    
69. Dim fso, pname
    
70. Set fso = CreateObject("Scripting.FileSystemObject")
    
71.     If fso.FileExists(FilePath) Then
    
72.         Set pname = fso.GetFile(FilePath)
    
73.         GetFilename = pname.Name
    
74.         Set psize = Nothing
    
75.     Else
    
76.         GetFilename = ""
    
77.     End If
    
78. Set fso = Nothing
    
79. End Function
    
80. Private Sub Class_Initialize()
    
81.     Set objDoc = New DOMDocument
    
82. End Sub
    
83. Private Sub Class_Terminate()
    
84.     Set objDoc = Nothing
    
85. End Sub

复制代码

1. 
   
2. Dim objDoc As DOMDocument
   
3. Dim strDocPath As String
   
4. Dim strXmlPath As String
   
5. Dim dx As New DocAndXml
   
6. Sub DocToXmlTest()
   
7.     strDocPath = CurrentProject.Path & "\Book1.xls"
   
8.     strXmlPath = CurrentProject.Path & "\XmlOuput.xml"
   
9.     dx.DocToXml strDocPath, strXmlPath
   
10. End Sub
    
11. Sub XmlToDocTest()
    
12.     strDocPath = CurrentProject.Path & "\Test1.xls"
    
13.     strXmlPath = CurrentProject.Path & "\XmlOuput.xml"
    
14.     dx.XmlToDoc strDocPath, strXmlPath
    
15. End Sub

复制代码

游客，如果您要查看本帖隐藏内容请回复

wu8313

很好用。直接使用了 '加密方式' 保存?

这样acc数据就可以导出为xml了，先导出为 xls 或者 doc，然后再改为 xml 。

也可以把记事本，压缩文档，先装入xml，然后释放出来。

谢谢fans提供。

[ 本帖最后由 wu8313 于 2008-8-31 22:22 编辑 ]

tmtony

不错的示例, 一个新的方向. 的确受到启发.

tanhong

非常好的代码，全新的思路．学习！[:50]

chenwm1973

[:50] [:50] [:50]

chenwm1973

请教fans：如何将下面数据读出。

  <?xml version="1.0" encoding="utf-8" ?>
- <root xmlns:dt="urn:schemas-microsoft-com:datatypes">
  <Item1>张三</Item1>
  <Item2>李四</Item2>
  <Item3>王五</Item3>
  </root>

如何将“张三，李四，王五”数据读出。
Set objnodes = objdom.documentElement.selectSingleNode("/root/item1")
        Text1.Text = objnodes.nodeTypedValue
我这么写怎么读不出？？

问题已经解决！！

[ 本帖最后由 chenwm1973 于 2008-9-18 13:27 编辑 ]

fan0217

楼顶已经更新了。

fan0217

原帖由 chenwm1973 于 2008-9-18 09:29 发表
请教fans：如何将下面数据读出。

   
-
  张三
  李四
  王五
  

如何将“张三，李四，王五”数据读出。
Set objnodes = objdom.documentElement.selectSingleNode("/root/item1")
        Text1.T ...

使用 objNode.Text

[ 本帖最后由 fan0217 于 2008-9-21 07:50 编辑 ]

chenwm1973

[:35] [:35]

freeoffice

asfas