將文檔保存到XML中，并將保存在XML中的文檔還原。

fan0217

這是個有趣的過程，使用前先引用xml


創(chuàng)建個類模塊：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

復(fù)制代碼

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

復(fù)制代碼

游客，如果您要查看本帖隱藏內(nèi)容請回復(fù)

wu8313

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

這樣acc數(shù)據(jù)就可以導(dǎo)出為xml了，先導(dǎo)出為 xls 或者 doc，然后再改為 xml 。

也可以把記事本，壓縮文檔，先裝入xml，然后釋放出來。

謝謝fans提供。

[ 本帖最后由 wu8313 于 2008-8-31 22:22 編輯 ]

tmtony

不錯的示例, 一個新的方向. 的確受到啟發(fā).

tanhong

非常好的代碼，全新的思路．學(xué)習(xí)！[:50]

chenwm1973

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

chenwm1973

請教fans：如何將下面數(shù)據(jù)讀出。

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

如何將“張三，李四，王五”數(shù)據(jù)讀出。
Set objnodes = objdom.documentElement.selectSingleNode("/root/item1")
        Text1.Text = objnodes.nodeTypedValue
我這么寫怎么讀不出？？

問題已經(jīng)解決�。�

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

fan0217

樓頂已經(jīng)更新了。

fan0217

原帖由 chenwm1973 于 2008-9-18 09:29 發(fā)表
請教fans：如何將下面數(shù)據(jù)讀出。

   
-
  張三
  李四
  王五
  

如何將“張三，李四，王五”數(shù)據(jù)讀出。
Set objnodes = objdom.documentElement.selectSingleNode("/root/item1")
        Text1.T ...

使用 objNode.Text

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

chenwm1973

[:35] [:35]

freeoffice

asfas