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 '上述代码来源于AccXP网站
