How to Load and Show Image in Microsoft Access through VBA code


Here's given an article which will guide you to know that how to load a picture and show that using VBA code in MS- access. One can load a picture from anywhere from their system and can display that into an image box. To do this, follow the procedure given below.

As shown in Fig: - 1.1 ,You have to create a table containing fields for the image name and type of the image.

How to Load and show a picture using VBA-Fig:-1.1

Fig:-1.1

Fig: -1.2 shows a form which is having two buttons, one is to load the picture into the list box and the next one is to show the picture into the image box.

How to Load and show a picture using VBA-Fig:-1.2

Fig:-1.2

When one will click onto the "Load Picture" button then a popup window will appear, to load the picture. As Shown in Fig: - 1.3.

How to Load and show a picture using VBA-Fig:-1.3

Fig:-1.3

When you will select the image from the pop up window, it will get load into the list box. Fig: - 1.4 shows the loaded image.

How to Load and show a picture using VBA-Fig:-1.4

Fig:-1.4

To show a picture into the Image Box, one has to select the image from the List Box and after clicking on "Show Picture" button the picture will appear into the Image Box. Fig: - 1.5 shows the selected image in the image box.

How to Load and show a picture using VBA-Fig:-1.5

Fig:-1.5

For the above example the complete VBA Code is given here:-
Note:-Don't forget to add references for Microsoft ActiveX Data Object Library


'------------------- Code for On Click event of the "Load Picture " button . -------------------

Private Sub cmdLoad_Click()
Dim strFilePath As String
strFilePath = Trim (OpenFileSelectionDialog( "Change Your Photo"))
if (strFilePath <> 0) Then
LoadPicIntoDatabase strFilePath
CurrentDb.Execute "UPDATE Table1 SET imgName = '" & Replace(Mid(strFilePath, InStrRev(strFilePath, "\") + 1, Len(strFilePath)), Chr(0), vbNullString) & "' WHERE imgID = " & DMax("imgID", "Table1")
Me.lstImages.Requery
End If
End Sub

'------------------- Code for On Click event of the "Show Picture " button . -------------------

Private Sub cmdShow_Click()
Dim sTempPicture As String
Dim RS As DAO.Recordset
sTempPicture = CurrentProject.Path & "\TempImage.jpg"
Set RS = CurrentDb.OpenRecordset("SELECT * FROM Table1 WHERE imgID = " & Me.lstImages & "", dbOpenDynaset, dbSeeChanges)
If Not (RS.EOF And RS.BOF) Then
Call BlobToFile(sTempPicture, RS("imgData"))
If Dir(sTempPicture) <> "" Then
Me.imgPicture.Picture = sTempPicture
End If
End If
RS.Close
Set RS = Nothing
End Sub

'------------------- Function to load the picture from the selected path--------------

Public Function LoadPicIntoDatabase(sFilePathAndName As String) As Boolean
On Error GoTo ErrHandler

If Dir(sFilePathAndName) = "" Then Exit Function
LoadPicIntoDatabase = True
Dim cn As ADODB.Connection
Set cn = CurrentProject.Connection
Dim RS As ADODB.Recordset
Dim mstream As ADODB.Stream
Dim strQry As String

strQry = "SELECT * FROM Table1"

Set RS = New ADODB.Recordset
With RS
.LockType = adLockOptimistic
.CursorLocation = adUseClient
.CursorType = adOpenDynamic
.Open strQry, cn
End With

Set mstream = New ADODB.Stream
mstream.Open
mstream.Type = adTypeBinary
mstream.LoadFromFile sFilePathAndName
RS.AddNew
RS.Fields("imgData") = mstream.Read
RS.Update

Cleanup:
On Error Resume Next
RS.Close
mstream.Close
Set mstream = Nothing
Set RS = Nothing
Set cn = Nothing

Exit Function

ErrHandler:
MsgBox "Error: " & Err.Number & " " & Err.Description
LoadPicIntoDatabase = False
Resume Cleanup
End Function

'------------------- Function to show the selected image--------------

Public Function BlobToFile(strFile As String, ByRef fldField As Object) As Long
On Error GoTo Err_BlobToFile

Dim intFileNum As Integer
Dim abytData() As Byte

BlobToFile = 0
intFileNum = FreeFile
Open strFile For Binary Access Write As intFileNum
abytData = fldField
Put #intFileNum, , abytData
BlobToFile = LOF(intFileNum)

Exit_BlobToFile:
If intFileNum > 0 Then Close intFileNum
Exit Function

Err_BlobToFile:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error writing file in BlobToFile"
BlobToFile = 0
Resume Exit_BlobToFile
End Function

Public Function OpenFileSelectionDialog( OpenTitle As String) As String
On Error GoTo ErrHndlr

Dim F As Object
Set F = Application.FileDialog(3)
F.AllowMultiSelect = False
F.title = title
F.Filters.Clear
Call F.Filters.Add(Description:="Image Files", Extensions:="*.jpg;*.png;*.gif;*.bmp;*.ico;*.jpeg")
F.show
OpenFileSelectionDialog = F.SelectedItems(1)
End Function
ErrHndlr:
If Err.Number = 5 Then
OpenFileSelectionDialog = "",
End If
End Function


DISCLAIMER

It is advised that the information provided in the article should not be used for any kind formal or production programming purposes as content of the article may not be complete or well tested. Access Guru will not be responsible for any kind of damage (monetary, time, personal or any other type) which may take place because of the usage of the content in the article.