设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 10032|回复: 6
打印 上一主题 下一主题

[Access本身] 如何读写OLE字段, 即保存文件到表中OLE字段中,并可读出来,释放到文件

[复制链接]

点击这里给我发消息

跳转到指定楼层
1#
发表于 2007-10-26 10:50:04 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
'有几位网友都问过有关如何读写OLE字段内容的问题,在这里贴出几个解决办法,供大家参考


'---------------------------------【问题症状】----------------------------------------
如何读写OLE字段, 即保存文件到表中OLE字段中,并可读出来,释放到文件

'---------------------------------【专家解答】----------------------------------------


方法一(tmtony)

保存文件到字段:
Public Function SaveFileToField(ByRef fld As ADODB.Field, DiskFile As String) As Boolean
On Error GoTo ErrorHandle
    Const BLOCKSIZE = 4096
    Dim byteData() As Byte '定义数据块数组
    Dim NumBlocks As Long '定义数据块个数
    Dim FileLength As Long '标识文件长度
    Dim LeftOver As Long '定义剩余字节长度
    Dim SourceFile As Long '定义自由文件号
    Dim I As Long '定义循环变量
    SourceFile = FreeFile '提供一个尚未使用的文件号
    Open DiskFile For Binary Access Read As SourceFile '打开文件
    FileLength = LOF(SourceFile) '得到文件长度
    If FileLength = 0 Then '判断文件是否存在
    Close SourceFile
    MsgBox DiskFile & "无 内 容 或 不 存 在 !"
    Else
    NumBlocks = FileLength \ BLOCKSIZE '得到数据块的个数
    LeftOver = FileLength Mod BLOCKSIZE '得到剩余字节数
    fld.Value = Null
    ReDim byteData(BLOCKSIZE) '重新定义数据块的大小
    For I = 1 To NumBlocks
    Get SourceFile, , byteData() ' 读到内存块中
    fld.AppendChunk byteData() '写入FLD
    Next I
    ReDim byteData(LeftOver) '重新定义数据块的大小
    Get SourceFile, , byteData() '读到内存块中
    fld.AppendChunk byteData() '写入FLD
   
    Close SourceFile '关闭源文件
    End If
        SaveFileToField = True
        Exit Function
   
ErrorHandle:
        SaveFileToField = False
        MsgBox Err.Description, vbCritical, "写入数据出错!"
   
End Function
保存字段内容到文件:
Public Function GetFileFromField(blobColumn As ADODB.Field, ByVal FILENAME) As Boolean
Dim FileNumber      As Integer      '文件号
Dim DataLen             As Long         '文件长度
Dim Chunks              As Long         '数据块数
Dim ChunkAry()      As Byte         '数据块数组
Dim ChunkSize       As Long         '数据块大小
Dim Fragment        As Long         '零碎数据大小
Dim lngI                As Long '计数器
   
        On Error GoTo ErrorHandle
        GetFileFromField = False
        ChunkSize = 2048                    '定义块大小为 2K
        If IsNull(blobColumn) Then Exit Function
   
        DataLen = blobColumn.ActualSize         '获得图像大小
        If DataLen < 8 Then Exit Function   '图像大小小于8字节时认为不是图像信息
            FileNumber = FreeFile               '产生随机的文件号
        Open FILENAME For Binary Access Write As FileNumber     '打开存放图像数据文件
        Chunks = DataLen \ ChunkSize        '数据块数
        Fragment = DataLen Mod ChunkSize    '零碎数据
        If Fragment > 0 Then            '有零碎数据,则先读该数据
                ReDim ChunkAry(Fragment - 1)
                ChunkAry = blobColumn.GetChunk(Fragment)
                Put FileNumber, , ChunkAry      '写入文件
        End If
   
        ReDim ChunkAry(ChunkSize - 1)             '为数据块重新开辟空间
        For lngI = 1 To Chunks                              '循环读出所有块
                ChunkAry = blobColumn.GetChunk(ChunkSize)   '在数据库中连续读数据块
                Put FileNumber, , ChunkAry()    '将数据块写入文件中
        Next lngI
        Close FileNumber            '关闭文件
        GetFileFromField = True
        Exit Function
ErrorHandle:
        GetFileFromField = False
        MsgBox Err.Description, vbCritical, "读取数据出错!"
End Function


方法二(笨小漆)


如何将文件保存在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

MsAccess补充:非常感谢,另两点建议,不知妥否:  
1.recset(strField).Type <> DB_OLE Or Not IsFileName(objFileName) 可改为
recset(strField).Type <> 205 Or Dir(objFileName) = ""
2.GetFileSize(objFileName) 可改为
FileLen(objFileName)
zhuyiwen补充
在ADP中,对应 image 字段。
recset(strField).Type <> DB_OLE Or Not IsFileName(objFileName) 要改为
recset(strField).Type <> adLongVarBinary Or Dir(objFileName) = ""


方法三(cg1)
一个mdb文件,可以自动把所有的需要调用的文件解包到指定目录。不用ole字段完全可以做到。
ole控件的名字.Action = acOLEActivate
记得把rar自解压缩包存到窗体的ole控件里面哈

方法四(不详)

将ADO数据库中的图象拷贝到文件中
Private Function GetRandomFileName(sDirTarget As String, _
sPrefix As String, _
sExtention As String) As String
'Generates a unique temp file name for the specified directory
'with the specified extention
On Error Resume Next
Dim fs As FileSystemObject ' **** requires filesystem object
Dim sFName As String
Dim iRnd As Long
Dim iUpperBound As Long, iLowerbound As Long
TRYAGAIN:
Randomize
iUpperBound = 99
iLowerbound = 0
iRnd = Int((iUpperBound - iLowerbound + 1) * Rnd + iLowerbound)
sFName = CStr(iRnd) + CStr(DatePart("d", Now())) _
+ CStr(DatePart("h", Now())) _
+ CStr(DatePart("n", Now()))
sFName = sPrefix + sFName + "." + sExtention
Set fs = New FileSystemObject
If Not fs.FileExists(sDirTarget + "\" + sFName) Then
GetRandomFileName = sDirTarget + sFName
Exit Function
Else
GoTo TRYAGAIN
End If
End Function
Public Function CopyImageField(fld As ADODB.Field, _
fldTO As ADODB.Field)
'This function takes the source field image and copies it
'into the destination field.
'The function first saves the image in the source field to a
'temp file on disc. Then reads this temp file into
'the destination field.
'The temp file is then deleted
On Error Resume Next
Dim iFieldSize As Long
Dim varChunk As Variant
Dim baData() As Byte
Dim iOffset As Long
Dim sFName As String
Dim iFileNum As Long
Dim cnt As Long
Dim z() As Byte
Const CONCHUNKSIZE As Long = 16384
Dim iChunks As Long
Dim iFragmentSize As Long
'Get a unique random filename
sFName = GetRandomFileName(App.Path, "pic", "tmp")
'Open a file to output the data to
iFileNum = FreeFile
Open sFName For Binary Access Write Lock Write As iFileNum
'Copy the logo to a variable in chunks.
iFieldSize = fld.ActualSize
iChunks = iFieldSize / CONCHUNKSIZE
iFragmentSize = iFieldSize Mod CONCHUNKSIZE
If iFragmentSize > 0 Then
' if there is a frag then write it first, else just use chunk
ReDim baData(iFragmentSize)
baData() = fld.GetChunk(iFragmentSize)
Put iFileNum, , baData()
End If
'Fragment added; Now write rest of chunks
ReDim baData(CONCHUNKSIZE)
For cnt = 1 To iChunks
baData() = fld.GetChunk(CONCHUNKSIZE)
Put iFileNum, , baData
Next cnt
'Close file
Close iFileNum
'Now we have the file on disk Load the pic from
'the temp file into the other field
Open sFName For Binary Access Read As #1
ReDim z(FileLen(sFName))
Get #1, , z()
fldTO.AppendChunk z
Close #1
'Delete the file
Kill (sFName)
End Function
返回

'---------------------------------【专家点评】----------------------------------------   
以下代码是将文件以二进制存储在OLE字段中,与手动(右键单击OLE字段,选"插入对象")将文件嵌入到OLE字段中是不同的。以二进制方法存储文件无法直接在字段中编辑,必须读出存为文件才能编辑,编辑完成后再写入到OLE字段中。
如果要读取手动插入的文件,请参考tmtony有关OLE字段内容剖析的文章

本帖被以下淘专辑推荐:

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏2 分享分享 分享淘帖1 订阅订阅
2#
发表于 2007-10-26 12:18:58 | 只看该作者
不错的文章,收藏。
3#
发表于 2007-10-26 12:29:45 | 只看该作者
不错,很祥细
不知这几种方法那种会更优些,现在我用的是类似笨小漆的方法
4#
发表于 2007-10-26 13:33:42 | 只看该作者
收藏先

点击这里给我发消息

5#
发表于 2007-10-26 20:39:09 | 只看该作者
谢谢,先收藏再学习
6#
发表于 2009-5-7 11:10:11 | 只看该作者
学习一下
7#
发表于 2014-11-6 17:10:23 | 只看该作者
请教一下,在窗体上要怎么调用?谢谢
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-13 11:18 , Processed in 0.076322 second(s), 32 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

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