[分享]成功解决ＤＯＣ文档写入Access数据库并完整读出的问题

lengyff

要理解这个例子的步骤最好是:
1、先看这个并下载例子文件，实际操作感受一下楼主的用意；
http://club.excelhome.net/thread-74977-1-1.html

2、再看本例子并下载文件自己琢磨分析，方能大致理解楼主意图。谢谢楼主的引领作用！
http://club.excelhome.net/viewthread.php?tid=142907&extra=&page=1

3、要是楼主能把access中的操作方式和长二进制代码弄个gif动画展示就好了，否则都是乱糟糟的弄不清晰。

4、如何将文件保存在OLE字段里(OLE写入/读出)？OLE文件读入和读出

支持的类型使所有文件，当然，你在读入数据的时候，最好做一个字段保存文件的类型，在保存文件的时候，就可以根据类型选择要保存的类型了。
Option Compare Database
Option Explicit  

Public Function GetFromFile(strTable As String, strField As String, strFilter As String, objFileName As String) As Boolean

'============================================================
'　过程函数名： CommModule.GetFromFile　类型：Function
'　参数：
'　　　　 strTable (String)　　：准备保存图形数据的表名称
'　　　　 strField (String)　　：准备保存图形数据的字段名称
'　　　　 strFilter (String)　 ：打开表的过滤字符串，用于定位并确保被打开的表的数据的唯一性
'　　　　 objFileName (String) ：准备输入到表里边的图象文件名称
'　返回：如果保存成功，返回True，如果失败，返回False
'-------------------------------------------------------------
'　说明：把图象文件的数据保存到表里边
'-------------------------------------------------------------
'　修订历史：
'=============================================================
Dim recset　　 As ADODB.Recordset, FileData() As Byte, FileNo As Long, FileSize As Long, strSQL As String

　　strSQL = "Select " & strField & " From " & strTable & " Where " & strFilter & ";"
　　Set recset = New ADODB.Recordset
　　recset.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
　　GetFromFile = True
　　If recset(strField).Type <> DB_OLE Or Not IsFileName(objFileName) Then
　　　　GetFromFile = False　　　　 '如果字段不是OLE字段，或者文件不存在，返回错误
　　　　GoTo EndGetFromFile
　　End If
　　If recset.EOF Then　　　　　　　'如果记录不存在，返回错误
　　　　GetFromFile = False
　　　　GoTo EndGetFromFile
　　End If
　　FileSize = GetFileSize(objFileName) '如果被打开的文件大小为零，返回错误
　　If FileSize <= 0 Then
　　　　GetFromFile = False
　　　　GoTo EndGetFromFile
　　End If
　　ReDim FileData(FileSize)　　　　　　'重新初始化数组
　　FileNo = FreeFile　　　　　　　　　 '获取一个空闲的文件号
　　Open objFileName For Binary As #FileNo　'打开文件
　　Get #FileNo, , FileData()　　　　　 '读取文件内容到数组
　　Close #FileNo　　　　　　　　　　　 '关闭文件
　　recset(strField).value = FileData() '保存数据
　　recset.Update　　　　　　　　　　　 '更新数据
　　Erase FileData　　　　　　　　　　　'释放内存
EndGetFromfile:
　　recset.Close　　　　　　　　　　　　'关闭RecordSet
　　Set recset = Nothing　　　　　　　　'释放内存
End Function

Public Function SaveToFile(strTable As String, strField As String, strFilter As String, strFileName As String) As Boolean
'============================================================
'　过程函数名： CommModule.SaveToFile 类型：Function
'　参数：
'　　　　 strTable (String)　　：保存图形数据的表名称
'　　　　 strField (String)　　：保存图形数据的字段名称
'　　　　 strFilter (String)　 ：打开表的过滤字符串，用于定位并确保被打开的表的纪录的唯一性
'　　　　 strFileName (String) ：准备保存的图象的文件名称
'　返回：如果保存成功，返回True，如果失败，返回False
'-------------------------------------------------------------
'　说明：把由GetFromFile函数保存到表中OLE字段的数据还原到文件
'-------------------------------------------------------------
'　修订历史：
'=============================================================
Dim recset　　 As ADODB.Recordset, FileData() As Byte, FileNo As Long, FileSize As Long, strSQL As String

　　strSQL = "Select " & strField & " From " & strTable & " Where " & strFilter & ";"
　　Set recset = New ADODB.Recordset
　　recset.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
　　SaveToFile = True
　　If recset(strField).Type <> DB_OLE Then
　　　　SaveToFile = False　　　　 '如果字段不是OLE字段，返回错误
　　　　GoTo EndSaveToFile
　　End If
　　If recset.EOF Then　　　　　　　'如果记录不存在，返回错误
　　　　SaveToFile = False
　　　　GoTo EndSaveToFile
　　End If
　　FileNo = FreeFile
　　Open strFileName For Binary As #FileNo
　　ReDim FileData(recset(strField).ActualSize) '重新初始化数组
　　FileData() = recset(strField).GetChunk(recset(strField).ActualSize) '把OLE字段的内容保存到数组
　　Put #FileNo, , FileData()　 '把数组内容保存到文件
　　Close #FileNo
　　Erase FileData
EndSaveTofile:
　　recset.Close
　　Set recset = Nothing
End Function

参考:www.access-cn.com

5、关于所谓的VBE引入组件问题
word中，按Alt+F11进入VBE界面-->工具-->引用-->Microsoft ActiveX Date Object 2.8打上勾.

6、开启ADODB.Stream组件的办法
在开始—运行里执行:regsvr32 "C:\Program Files\Common Files\System\ado\msado15.dll

[ 本帖最后由 lengyff 于 2009-11-3 14:57 编辑 ]

flymeteor

楼主真是强大啊

hangye

真是强大啊

ftogtong

顶顶，我正找它呢

xdm619

2005年，我使用authorware做一个考试系统，就需要读取带图文混排的word文档题库，结果由于authorware中无法读取word文档（或者我没有找到相关控件），结果，制作题库时，只有一题一个图片，费了九牛二虎之力，而且维护起来相当麻烦，要是早点拜读楼主的大作，也许就会少走许多弯路。
如此强贴，大力地顶！楼主辛苦了！

xmyjk

太厉害的技术贴，谢谢分享。

Kelidai

收藏学习，谢谢分享，看看能不能做成自动生成的合同。

zhanggangchd

我有大量WORD文档是用插入对象的方法加到数据库的,所以读出的是一堆乱码.再改回去不可能了,有没有办法解决?请大家赐教.

zhanggangchd

我试了一下你的代码,生成的DOC文件用WORD打开是乱码.

li2t

能否在asp 网页中读出2进制的word文档