VB and VBA Users Source Code: Load and Save Images to a Database
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Load and Save Images to a Database
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, March 12, 2001
Hits:
1540
Category:
Windows API
Article:
The following code illustates how to save and load images to and from a database using AppendChunk and GetChunk methods of an ADO recordset. There are two sample routines at the bottom of this post showing how to use these generic routines. Notes: For Access Database's the field should be of the "OLE Object" type and for SQL server use the "image" type. You will need to add a reference to Microsoft ActiveX Data Objects X.X Library (Where X.X >= 2.1). You will need to add a PictureBox control to a form to run the test routines. Option Explicit Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long 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 'Purpose : Saves pictures in image boxes (or similiar) to a field in a recordset 'Inputs : oPictureControl A control containing an image ' adoRS ADO recordset to add the image to ' sFieldName The field name in adoRS, to add the image to 'Outputs : Returns True if succeeded in updating the recordset 'Author : Andrew Baker 'Date : 03/09/2000 13:58 'Notes : The field specified in sFieldName, must have a binary field type (ie. OLE Object in access) ' Save the image at the currect cursor location in the recordset. 'Revisions : Public Function SavePictureToDB(oPictureControl As Object, adoRS As ADODB.Recordset, sFieldName As String) As Boolean Dim oPict As StdPicture Dim sDir As String, sTempFile As String Dim iFileNum As Integer Dim lFileLength As Long Dim abBytes() As Byte Dim iCtr As Integer On Error GoTo ErrHandler Set oPict = oPictureControl.Picture If oPict Is Nothing Then SavePictureToDB = False Exit Function End If 'Save picture to temp file sTempFile = FileGetTempName SavePicture oPict, sTempFile 'read file contents to byte array iFileNum = FreeFile Open sTempFile For Binary Access Read As #iFileNum lFileLength = LOF(iFileNum) ReDim abBytes(lFileLength) Get #iFileNum, , abBytes() 'put byte array contents into db field adoRS.Fields(sFieldName).AppendChunk abBytes() Close #iFileNum 'Don't return false if file can't be deleted On Error Resume Next Kill sTempFile SavePictureToDB = True Exit Function ErrHandler: SavePictureToDB = False Debug.Print Err.Description End Function 'Purpose : Loads a Picture, saved as binary data in a database, from a recordset into a picture control. 'Inputs : oPictureControl A control to load the image into ' adoRS ADO recordset to add the image to ' sFieldName The field name in adoRS, to add the image to 'Outputs : Returns True if succeeded in loading the image 'Author : Andrew Baker 'Date : 03/09/2000 14:32 'Notes : Loads the image at the currect cursor location in the recordset. 'Revisions : Public Function LoadPictureFromDB(oPictureControl As Object, adoRS As ADODB.Recordset, sFieldName As String) As Boolean Dim oPict As StdPicture Dim sDir As String Dim sTempFile As String Dim iFileNum As Integer Dim lFileLength As Long Dim abBytes() As Byte Dim iCtr As Integer On Error GoTo ErrHandler sTempFile = FileGetTempName iFileNum = FreeFile Open sTempFile For Binary As #iFileNum lFileLength = LenB(adoRS(sFieldName)) abBytes = adoRS(sFieldName).GetChunk(lFileLength) Put #iFileNum, , abBytes() Close #iFileNum oPictureControl.Picture = LoadPicture(sTempFile) Kill sTempFile LoadPictureFromDB = True Exit Function ErrHandler: LoadPictureFromDB = False Debug.Print Err.Description End Function 'Purpose : The FileGetTempName function returns a name of a temporary file. 'Inputs : [sFilePrefix] The prefix of the file name. 'Outputs : Returns the name of the next free temporary file name (and path). 'Author : Andrew Baker 'Date : 03/09/2000 14:17 'Notes : The filename is the concatenation of specified path and prefix strings, ' a hexadecimal string formed from a specified integer, and the .TMP extension 'Revisions : Function FileGetTempName(Optional sFilePrefix As String = "TMP") As String Dim sTemp As String * 260, lngLen As Long Static ssTempPath As String If LenB(ssTempPath) = 0 Then 'Get the temporary path lngLen = GetTempPath(260, sTemp) 'strip the rest of the buffer ssTempPath = Left$(sTemp, lngLen) If Right$(ssTempPath, 1) <> "\" Then ssTempPath = ssTempPath & "\" End If End If 'Get a temporary filename lngLen = GetTempFileName(ssTempPath, sFilePrefix, 0, sTemp) 'Remove all the unnecessary chr$(0)'s FileGetTempName = Left$(sTemp, InStr(1, sTemp, Chr$(0)) - 1) End Function 'SAMPLE USAGE 'NOTE : Add a PictureBox control to a form before running this code Sub TestLoadPicture() Dim sConn As String Dim oConn As New ADODB.Connection Dim oRs As New ADODB.Recordset On Error GoTo ErrFailed sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyDb.MDB;Persist Security Info=False" oConn.Open sConn oRs.Open "SELECT * FROM MyTable", oConn, adOpenKeyset, adLockOptimistic If oRs.EOF = False Then LoadPictureFromDB Picture1, oRs, "MyFieldName" End If oRs.Close Exit Sub ErrFailed: MsgBox "Error " & Err.Description End Sub 'SAMPLE USAGE 'NOTE : Add a PictureBox control to a form before running this code Sub TestSavePicture() Dim sConn As String Dim oConn As New ADODB.Connection Dim oRs As New ADODB.Recordset On Error GoTo ErrFailed sConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyDb.MDB;Persist Security Info=False" oConn.Open sConn oRs.Open "SELECT * FROM MYTABLE", oConn, adOpenKeyset, adLockOptimistic If oRs.EOF = False Then oRs.AddNew SavePictureToDB Picture1, oRs, "MYFIELD" oRs.Update End If oRs.Close Exit Sub ErrFailed: MsgBox "Error " & Err.Description End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
