یه نمونه کد از office online برای فایلهای BlobدرMdb فایل گرفتم که براتون میذارم ابتدا یک پروژه MDB ایجاد کنین حال مراحل ذیل را دنبال نمائید.
1- ابتدا یک ماژول جدید ایجاد نمایید سپس کد ذیل را درون آن قرار دهید.
Option Compare Database
Option Explicit
Const BlockSize = 32768
Const dbOpenTable = DB_OPEN_TABLE
Const acSysCmdInitMeter = SYSCMD_INITMETER
Const acSysCmdUpdateMeter = SYSCMD_UPDATEMETER
Const acSysCmdRemoveMeter = SYSCMD_REMOVEMETER
'************************************************* *************
' FUNCTION: ReadBLOB()
'
' PURPOSE:
' Reads a BLOB from a disk file and stores the contents in the
' specified table and field.
'
' PREREQUISITES:
' The specified table with the OLE object field to contain the
' binary data must be opened in Visual Basic code (Access Basic
' code in Microsoft Access 2.0 and earlier) and the correct record
' navigated to prior to calling the ReadBLOB() function.
'
' ARGUMENTS:
' Source - The path and filename of the binary information
' to be read and stored.
' T - The table object to store the data in.
' Field - The OLE object field in table T to store the data in.
'
' RETURN:
' The number of bytes read from the Source file.
'************************************************* *************
Function ReadBLOB(Source As String, T As Recordset, _
sField As String)
Dim NumBlocks As Integer, SourceFile As Integer, i As Integer
Dim FileLength As Long, LeftOver As Long
Dim FileData As String
Dim RetVal As Variant
On Error GoTo Err_ReadBLOB
' Open the source file.
SourceFile = FreeFile
Open Source For Binary Access Read As SourceFile
' Get the length of the file.
FileLength = LOF(SourceFile)
If FileLength = 0 Then
ReadBLOB = 0
Exit Function
End If
' Calculate the number of blocks to read and leftover bytes.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
' SysCmd is used to manipulate status bar meter.
RetVal = SysCmd(acSysCmdInitMeter, "Reading BLOB", _
FileLength \ 1000)
' Put the record in edit mode.
T.Edit
' Read the leftover data, writing it to the table.
FileData = String$(LeftOver, 32)
Get SourceFile, , FileData
T(sField).AppendChunk (FileData)
RetVal = SysCmd(acSysCmdUpdateMeter, LeftOver / 1000)
' Read the remaining blocks of data, writing them to the table.
FileData = String$(BlockSize, 32)
For i = 1 To NumBlocks
Get SourceFile, , FileData
T(sField).AppendChunk (FileData)
RetVal = SysCmd(acSysCmdUpdateMeter, BlockSize * i / 1000)
Next i
' Update the record and terminate function.
T.Update
RetVal = SysCmd(acSysCmdRemoveMeter)
Close SourceFile
ReadBLOB = FileLength
Exit Function
Err_ReadBLOB:
ReadBLOB = -Err
Exit Function
End Function
'************************************************* *************
' FUNCTION: WriteBLOB()
'
' PURPOSE:
' Writes BLOB information stored in the specified table and field
' to the specified disk file.
'
' PREREQUISITES:
' The specified table with the OLE object field containing the
' binary data must be opened in Visual Basic code (Access Basic
' code in Microsoft Access 2.0 or earlier) and the correct
' record navigated to prior to calling the WriteBLOB() function.
'
' ARGUMENTS:
' T - The table object containing the binary information.
' sField - The OLE object field in table T containing the
' binary information to write.
' Destination - The path and filename to write the binary
' information to.
'
' RETURN:
' The number of bytes written to the destination file.
'************************************************* *************
Function WriteBLOB(T As Recordset, sField As String, _
Destination As String)
Dim NumBlocks As Integer, DestFile As Integer, i As Integer
Dim FileLength As Long, LeftOver As Long
Dim FileData As String
Dim RetVal As Variant
On Error GoTo Err_WriteBLOB
' Get the size of the field.
FileLength = T(sField).FieldSize()
If FileLength = 0 Then
WriteBLOB = 0
Exit Function
End If
' Calculate number of blocks to write and leftover bytes.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
' Remove any existing destination file.
DestFile = FreeFile
Open Destination For Output As DestFile
Close DestFile
' Open the destination file.
Open Destination For Binary As DestFile
' SysCmd is used to manipulate the status bar meter.
RetVal = SysCmd(acSysCmdInitMeter, _
"Writing BLOB", FileLength / 1000)
' Write the leftover data to the output file.
FileData = T(sField).GetChunk(0, LeftOver)
Put DestFile, , FileData
' Update the status bar meter.
RetVal = SysCmd(acSysCmdUpdateMeter, LeftOver / 1000)
' Write the remaining blocks of data to the output file.
For i = 1 To NumBlocks
' Reads a chunk and writes it to output file.
FileData = T(sField).GetChunk((i - 1) * BlockSize _
+ LeftOver, BlockSize)
Put DestFile, , FileData
RetVal = SysCmd(acSysCmdUpdateMeter, _
((i - 1) * BlockSize + LeftOver) / 1000)
Next i
' Terminates function
RetVal = SysCmd(acSysCmdRemoveMeter)
Close DestFile
WriteBLOB = FileLength
Exit Function
Err_WriteBLOB:
WriteBLOB = -Err
Exit Function
End Function
'************************************************* *************
' SUB: CopyFile
'
' PURPOSE:
' Demonstrates how to use ReadBLOB() and WriteBLOB().
'
' PREREQUISITES:
' A table called BLOB that contains an OLE Object field called
' Blob.
'
' ARGUMENTS:
' Source - The path and filename of the information to copy.
' Destination - The path and filename of the file to write
' the binary information to.
'
' EXAMPLE:
' CopyFile "c:\windows\winfile.hlp", "c:\windows\winfil_1.hlp"
'************************************************* *************
Sub CopyFile(Source As String, Destination As String)
Dim BytesRead As Variant, BytesWritten As Variant
Dim Msg As String
Dim db As Database
Dim T As Recordset
' Open the BLOB table.
Set db = CurrentDb()
Set T = db.OpenRecordset("BLOB", dbOpenTable)
' Create a new record and move to it.
T.AddNew
T.Update
T.MoveLast
BytesRead = ReadBLOB(Source, T, "Blob")
Msg = "Finished reading """ & Source & """"
Msg = Msg & Chr$(13) & ".. " & BytesRead & " bytes read."
MsgBox Msg, 64, "Copy File"
BytesWritten = WriteBLOB(T, "Blob", Destination)
Msg = "Finished writing """ & Destination & """"
Msg = Msg & Chr$(13) & ".. " & BytesWritten & " bytes written."
MsgBox Msg, 64, "Copy File"
End Sub
2- حال یک جدول ایجاد نمائید و نام آن راblob قرار دهید که حاوی یه فیلد با نام blob و ازنوع ole باشد.
3- کد ذیل را درون event مورد نظر قرار دهید که شامل کپی فایل در جدولو سپس Save as نمودن آن با یک نام دیگر است
CopyFile "c:\windows\winfile.hlp", "c:\windows\winfil_1.hlp"
نمونه برنامه
دانلود
نوشته شده توسط sarami
یه نمونه کد از office online برای فایلهای BlobدرMdb فایل گرفتم که براتون میذارم ابتدا یک پروژه MDB ایجاد کنین حال مراحل ذیل را دنبال نمائید.
پاسخ با نقل قول