|
本帖最后由 sgrshh29 于 2010-5-20 10:42 编辑
5# sxb2007
写了比较详细的注释,ado部分就不写注释了。不要忘记引用ado!
先设计一个表,名称为tbl,二个字段:ID为自动编号主键,fole为ole用来储存二进制数据
再设计一个窗体名称为窗体1,添加一个文本框名称为text0,用来显示记录的ID、一个导入按钮,一个导出按钮。窗体代码自己根据需要写。
下面是导入导出模块
导入模块
Sub FileToOle(strFileName As String) ‘strFileName为将要保存到数据库的完整文件名
If strFileName = "" Then Exit Sub
Const BufferSize As Long = 1000# * 1024# '块长度,这里为1M
Dim lFileSize As Long ‘文件长度
Dim FileNo As Long ’文件号
Dim FileData() As Byte ‘二进制数组
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Set cnn = CurrentProject.Connection
rs.Open "tbl", cnn, 3, 3
FileNo = FreeFile ‘获取文件号
Open strFileName For Binary As #FileNo ’用二进制打开文件
lFileSize = LOF(FileNo) ‘获取文件长度
rs.AddNew ’添加新记录
Do While lFileSize >= BufferSize ‘分块保存到fole字段
ReDim FileData(BufferSize) As Byte
Get FileNo, , FileData()
rs("fOLE").AppendChunk FileData()
DoEvents
lFileSize = lFileSize - BufferSize
Loop
If lFileSize > 0 Then ’将剩余字节保存到fole字段
ReDim FileData(lFileSize) As Byte
Get FileNo, , FileData()
rs("fOLE").AppendChunk FileData()
End If
rs.Update ‘善后,关闭及卸载所有打开的对象
Close #FileNo
rs.Close
Set rs = Nothing
Set cnn = Nothing
MsgBox "导入结束" '提醒
End Sub
导出模块
Sub OleToFile(strFileName As String)
If strFileName = "" Then Exit Sub
Const BufferSize As Long = 1000# * 1024#
Dim lFileSize As Long
Dim FileNo As Long
Dim FileData() As Byte
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Set cnn = CurrentProject.Connection
rs.Open "select * from tbl where id=" & Forms("窗体1").Controls("text0"), cnn, 3, 3
FileNo = FreeFile
Open strFileName For Binary As #FileNo
lFileSize = rs("fole").ActualSize
Do While lFileSize >= BufferSize
ReDim FileData(BufferSize) As Byte
FileData() = rs("fole").GetChunk(BufferSize)
Put #FileNo, , FileData()
DoEvents
lFileSize = lFileSize - BufferSize
Loop
If lFileSize > 0 Then
ReDim FileData(lFileSize) As Byte
FileData() = rs("fole").GetChunk(lFileSize)
Put #FileNo, , FileData()
End If
Close #FileNo
rs.Close
Set rs = Nothing
Set cnn = Nothing
MsgBox "导出结束"
End Sub |
|