Option Explicit
Private Const MAX_PATH = 260
Private Const BLOCK_SIZE = 10000
Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" _
(ByVal lpszPath As String, ByVal lpPrefixString As String, _
ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Sub ExtractImage(adoConn As ADODB.Connection, _
sPicId As String, imgTemp As Image)
'=======================================================================================
'NOTES:
'* this samples requires table ALL_PICTURES (could be any name) with at least 3 fields:
' - PICTURE_ID (could be text or number)
' - ACTUAL_IMAGE (OLE Object)
' - IMAGE_SIZE (Number - Long)
'
'* adoConn must be valid and open connection to your database
'* imgTemp can be define as Picturebox as well
'* also, instead of sPicId you may pass entire sql statement
'* logic is "adaptable" for any other database type including Oracle, SQL Server, ...
' however, field type will differ: in Oracle it would be "Long RAW" ...
'* you may add one more field IMAGE_TYPE (text) so you know what type of file is stored
' so if it is some kind of image then you would use LoadImage() or if is not then
' you may need to simply open extracted file.
'======================================================================================
Dim adoRST As ADODB.Recordset, strSql$
Dim bytes() As Byte
Dim file_name As String
Dim file_num As Integer
Dim file_length As Long
Dim num_blocks As Long
Dim left_over As Long
Dim block_num As Long
Dim hgt As Single
On Error GoTo ErrHandler
Screen.MousePointer = vbHourglass
DoEvents
strSql = "SELECT * FROM ALL_PICTURES WHERE PICTURE_ID = '" & sPicId & "'"
Set adoRST = New ADODB.Recordset
adoRST.Open strSql, adoConn
If adoRST.EOF Then
Screen.MousePointer = vbDefault
Exit Sub
End If
If IsNull(adoRST.Fields("ACTUAL_IMAGE")) Then
Screen.MousePointer = vbDefault
Exit Sub
End If
' Get a temporary file name.
file_name = TemporaryFileName()
' Open the file.
file_num = FreeFile
Open file_name For Binary As #file_num
' Copy the data into the file.
file_length = adoRST.Fields("IMAGE_SIZE")
num_blocks = file_length / BLOCK_SIZE
left_over = file_length Mod BLOCK_SIZE
'get all chunks and write then to a temp file
For block_num = 1 To num_blocks
bytes() = adoRST.Fields("ACTUAL_IMAGE").GetChunk(BLOCK_SIZE)
Put #file_num, , bytes()
Next block_num
If left_over > 0 Then
bytes() = adoRST.Fields("ACTUAL_IMAGE").GetChunk(left_over)
Put #file_num, , bytes()
End If
Close #file_num
'load image
'****************************************
imgTemp.Picture = LoadPicture(file_name)
'****************************************
Screen.MousePointer = vbDefault
Exit Sub
ErrHandler:
'-----------
Debug.Print Err.Description
Err.Clear
Screen.MousePointer = vbDefault
'Resume Next
Exit Sub
End Sub
Public Function TemporaryFileName() As String
'==============================================
Dim temp_path As String
Dim temp_file As String
Dim length As Long
' Get the temporary file path.
temp_path = Space$(MAX_PATH)
length = GetTempPath(MAX_PATH, temp_path)
temp_path = Left$(temp_path, length)
' Get the file name.
temp_file = Space$(MAX_PATH)
GetTempFileName temp_path, "per", 0, temp_file
TemporaryFileName = Left$(temp_file, InStr(temp_file, Chr$(0)) - 1)
End Function