'保存文件到字段:
'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
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
