'---------------------------------【问题症状】----------------------------------------
如何读写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 BooleanDim 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 FunctionErrorHandle: 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 extentionOn Error Resume NextDim fs As FileSystemObject ' **** requires filesystem objectDim sFName As StringDim iRnd As LongDim iUpperBound As Long, iLowerbound As Long
TRYAGAIN:
RandomizeiUpperBound = 99iLowerbound = 0iRnd = 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) ThenGetRandomFileName = sDirTarget + sFNameExit FunctionElseGoTo TRYAGAINEnd 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 deletedOn Error Resume Next
Dim iFieldSize As LongDim varChunk As VariantDim baData() As ByteDim iOffset As LongDim sFName As StringDim iFileNum As LongDim cnt As LongDim z() As Byte
Const CONCHUNKSIZE As Long = 16384
Dim iChunks As LongDim iFragmentSize As Long
'Get a unique random filenamesFName = GetRandomFileName(App.Path, "pic", "tmp")
'Open a file to output the data toiFileNum = FreeFileOpen sFName For Binary Access Write Lock Write As iFileNum
'Copy the logo to a variable in chunks.iFieldSize = fld.ActualSizeiChunks = iFieldSize / CONCHUNKSIZEiFragmentSize = iFieldSize Mod CONCHUNKSIZEIf iFragmentSize > 0 Then ' if there is a frag then write it first, else just use chunkReDim baData(iFragmentSize)baData() = fld.GetChunk(iFragmentSize)Put iFileNum, , baData()End If
'Fragment added; Now write rest of chunksReDim baData(CONCHUNKSIZE)For cnt = 1 To iChunksbaData() = fld.GetChunk(CONCHUNKSIZE)Put iFileNum, , baDataNext cnt
'Close fileClose 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 #1ReDim z(FileLen(sFName))Get #1, , z()fldTO.AppendChunk zClose #1
'Delete the fileKill (sFName)
End Function返回
'---------------------------------【专家点评】----------------------------------------
cg1：以下代码是将文件以二进制存储在OLE字段中，与手动(右键单击OLE字段，选"插入对象")将文件嵌入到OLE字段中是不同的。以二进制方法存储文件无法直接在字段中编辑，必须读出存为文件才能编辑，编辑完成后再写入到OLE字段中。
tmtony:如果要读取手动插入的文件,请参考tmtony《Access专家门诊》一书中有关OLE字段内容剖析的文章