设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

123下一页
返回列表 发新帖
查看: 10287|回复: 29

[模块/函数] 将文档保存到XML中,并将保存在XML中的文档还原。

[复制链接]
发表于 2008-8-31 16:09:34 | 显示全部楼层 |阅读模式
这是个有趣的过程,使用前先引用xml


创建个类模块:DocAndXml

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

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

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
发表于 2008-8-31 22:20:33 | 显示全部楼层
很好用。直接使用了 '加密方式' 保存?

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

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

谢谢fans提供。

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

点击这里给我发消息

发表于 2008-8-31 22:33:13 | 显示全部楼层
不错的示例, 一个新的方向. 的确受到启发.
发表于 2008-9-16 18:17:21 | 显示全部楼层
非常好的代码,全新的思路.学习![:50]
发表于 2008-9-16 18:58:05 | 显示全部楼层
[:50] [:50] [:50]
发表于 2008-9-18 09:29:46 | 显示全部楼层
请教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 编辑 ]
 楼主| 发表于 2008-9-20 23:54:54 | 显示全部楼层
楼顶已经更新了。
 楼主| 发表于 2008-9-20 23:58:30 | 显示全部楼层
原帖由 chenwm1973 于 2008-9-18 09:29 发表
请教fans:如何将下面数据读出。

   
-
  张三
  李四
  王五
  

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


使用 objNode.Text

[ 本帖最后由 fan0217 于 2008-9-21 07:50 编辑 ]
发表于 2008-9-22 20:45:23 | 显示全部楼层
[:35] [:35]
发表于 2008-10-8 14:33:30 | 显示全部楼层
asfas
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-3-29 00:47 , Processed in 0.087931 second(s), 36 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表