Const BLOCKSIZE = 8192
Public Sub SaveToDB(ByRef Fld As ADODB.Field, DiskFile As String)
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
End Sub
Public Sub ReadFromDB(ByRef Fld As ADODB.Field, DiskFile As String)
Dim byteData() As Byte '定义数据块数组
Dim NumBlocks As Long '定义数据块个数
Dim FileLength As Long '标识文件长度
Dim LeftOver As Long '定义剩余字节长度
Dim lOffset As Long
Dim SourceFile As Long '定义自由文件号
Dim i As Long '定义循环变量
SourceFile = FreeFile '提供一个尚未使用的文件号
Open DiskFile For Binary Access Write As SourceFile '打开文件
FileLength = Fld.ActualSize '得到字段的实际长度
If FileLength = 0 Then '判断文件是否存在
Close SourceFile
' MsgBox DiskFile & "无 内 容 或 不 存 在 !"
Exit Sub
Else
NumBlocks = FileLength / BLOCKSIZE '得到数据块的个数
LeftOver = FileLength Mod BLOCKSIZE '得到剩余字节数
'Fld.Value = Null
ReDim byteData(LeftOver) '重新定义数据块的大小
byteData() = Fld.GetChunk(LeftOver)
Put SourceFile, , byteData()
lOffset = LeftOver
For i = 1 To NumBlocks
ReDim byteData(BLOCKSIZE) '重新定义数据块的大小
byteData() = Fld.GetChunk(BLOCKSIZE) '从数据库中读出一数据块到内存中
Put SourceFile, , byteData() '从内存块写入文件中
lOffset = lOffset + BLOCKSIZE
txtByteCount = lOffset
Next i
Close SourceFile '关闭源文件
End If
Public Sub SaveToDB(ByRef Fld As ADODB.Field, DiskFile As String)
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
End Sub
Public Sub ReadFromDB(ByRef Fld As ADODB.Field, DiskFile As String)
Dim byteData() As Byte '定义数据块数组
Dim NumBlocks As Long '定义数据块个数
Dim FileLength As Long '标识文件长度
Dim LeftOver As Long '定义剩余字节长度
Dim lOffset As Long
Dim SourceFile As Long '定义自由文件号
Dim i As Long '定义循环变量
SourceFile = FreeFile '提供一个尚未使用的文件号
Open DiskFile For Binary Access Write As SourceFile '打开文件
FileLength = Fld.ActualSize '得到字段的实际长度
If FileLength = 0 Then '判断文件是否存在
Close SourceFile
' MsgBox DiskFile & "无 内 容 或 不 存 在 !"
Exit Sub
Else
NumBlocks = FileLength / BLOCKSIZE '得到数据块的个数
LeftOver = FileLength Mod BLOCKSIZE '得到剩余字节数
'Fld.Value = Null
ReDim byteData(LeftOver) '重新定义数据块的大小
byteData() = Fld.GetChunk(LeftOver)
Put SourceFile, , byteData()
lOffset = LeftOver
For i = 1 To NumBlocks
ReDim byteData(BLOCKSIZE) '重新定义数据块的大小
byteData() = Fld.GetChunk(BLOCKSIZE) '从数据库中读出一数据块到内存中
Put SourceFile, , byteData() '从内存块写入文件中
lOffset = lOffset + BLOCKSIZE
txtByteCount = lOffset
Next i
Close SourceFile '关闭源文件
End If
本文介绍了一种通过VBA实现文件数据与数据库之间的交互方法。具体包括将文件数据保存到数据库字段及从数据库字段读取数据并写入文件的过程。此方法适用于需要在文件与数据库间高效传输大量二进制数据的应用场景。
675

被折叠的 条评论
为什么被折叠?



