Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Microsoft: Access Modules (VBA Coding) FAQ

Using Images

How do I display images within access, storing only the path? by jgoodman00
Posted: 23 Nov 01

Displaying an image in access is commonly required. Whilst it has built in image handling functionality, the default method is very inefficient. By combining the built in functionality with some VB, you can produce a much more stable, more efficient way of handling images. It also only requires the storage of a path to the image, rather than the image being embedded within the db(leading to huge db files, because access converts jpg's to bmp's when stored inside a db).

Ok, you need a table, or an entry in your table, which will store the path to the image file. You then need a form which will read this field, if populate, & if valid display the image.

You need to create a module, with the following subs/functions in it:
'----------------Date Modified: 19/11/01---------------------------
'--------------------Modified By: James----------------------------
Option Compare Database
Option Explicit
   ' Declare call to comdlg32.dll to open the common file dialog
    Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
         "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
    ' Declare object passed to common dialog
         lStructSize As Long
         hwndOwner As Long
         hInstance As Long
         lpstrFilter As String
         lpstrCustomFilter As String
         nMaxCustFilter As Long
         nFilterIndex As Long
         lpstrFile As String
         nMaxFile As Long
         lpstrFileTitle As String
         nMaxFileTitle As Long
         lpstrInitialDir As String
         lpstrTitle As String
         flags As Long
         nFileOffset As Integer
         nFileExtension As Integer
         lpstrDefExt As String
         lCustData As Long
         lpfnHook As Long
         lpTemplateName As String
    End Type

    ' Declare call to kernel32.exe to use the openfile to check file
    ' existence ( Access DIR function can fail when using UNC for server/share names )
    Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String, _
                                             lpReOpenBuff As OFSTRUCT, _
                                             ByVal wStyle As Long) As Long
    ' Declare constants for passing to openfile
    Public Const OFS_MAXPATHNAME = 128
    Public Const OF_EXIST = &H4000
    ' Declare object used in openfile function
        cBytes As Byte
        fFixedDisk As Byte
        nErrCode As Integer
        Reserved1 As Integer
        Reserved2 As Integer
        szPathName(OFS_MAXPATHNAME) As Byte
    End Type

Function GetOpenFile(ByVal IN_INITIALDIR As String) As String
On Error GoTo GetOpenFile_Err

        Dim OpenFile As OPENFILENAME
        Dim LReturn As Long
        Dim sFilter As String
        Dim F_FILENAME As String
        F_FILENAME = ""
        OpenFile.lStructSize = Len(OpenFile)
        OpenFile.hwndOwner = Screen.ActiveForm.Hwnd
        OpenFile.hInstance = Application.hWndAccessApp
        sFilter = "JPEG Files (*.jpg)" & Chr(0) & "*.JPG" & Chr(0) & _
                  "TIFF Files (*.tif)" & Chr(0) & "*.TIF" & Chr(0) & _
                  "Bitmap Files (*.bmp)" & Chr(0) & "*.BMP" & Chr(0) & _
                  "MPEG Files (*.mpg)" & Chr(0) & "*.mpg" & Chr(0) & _
                  "AVI Files (*.avi)" & Chr(0) & "*.avi)" & Chr(0)
        OpenFile.lpstrFilter = sFilter
        OpenFile.nFilterIndex = 1
        OpenFile.lpstrFile = String(255, 0)
        OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
        OpenFile.lpstrFileTitle = OpenFile.lpstrFile
        OpenFile.nMaxFileTitle = OpenFile.nMaxFile
        OpenFile.lpstrInitialDir = "C:\Photograph\Civils"
        OpenFile.lpstrTitle = "Find the document image file"
        OpenFile.flags = 0
        If IN_INITIALDIR <> "" Then
            OpenFile.lpstrInitialDir = IN_INITIALDIR
            OpenFile.lpstrInitialDir = "C:\Photograph\Civils"
        End If
        LReturn = GetOpenFileName(OpenFile)
        If LReturn <> 0 Then
           F_FILENAME = Left$(OpenFile.lpstrFile, InStr(OpenFile.lpstrFile, Chr(0)) - 1)
           F_FILENAME = Trim(F_FILENAME)
        End If

        GetOpenFile = F_FILENAME
Exit Function

MsgBox Error$
Resume GetOpenFile_Exit

End Function

Function CheckFileExists(ByVal IN_FILENAME As String) As Integer
    Dim iresult As Integer
    Dim strucFname As OFSTRUCT
    Dim strSearchFile As String
    strSearchFile = IN_FILENAME
    iresult = OpenFile(strSearchFile, strucFname, OF_EXIST)
       'The above line causes OpenFile to search for the
       'file Test on the server network path.
       'Passing the OF_EXIST parameter tells the OpenFile
       'function to search for the file, the file will not be
       'opened or modified in any way.
    CheckFileExists = iresult

End Function

Public Function chkOpen() As Boolean
    Dim DataPath$
    Dim continue As Boolean
    Dim UpdateDB As DAO.Database
    Dim Status As Long
    On Error GoTo chkOpenErr

    ' Set the continue initially to success

    continue = True

    Set UpdateDB = DBEngine.Workspaces(0).Databases(0)

    ' This gives the full path and name of the database

    DataPath = UpdateDB.Name

    ' Set the database security settings depending if an mde database
    If LCase(Right(DataPath, 3)) = "mde" Then
        Status = csvToggleToolbars(0)
    End If

    chkOpen = continue
    Exit Function
    MsgBox "(" & Err & "): " & Error, 48
    continue = False
    Resume chkFinish
End Function

Function csvToggleToolbars(ByVal State As Integer) As Integer

'   Makes the toolbars available/Unavailable to the user
    Application.SetOption "built-in toolbars available", State

End Function

Next you need a form, with an unbound image control, an unbound text control, & a command button. You then need the following code in the forms class module:

'----------------Date Modified: 19/11/01---------------------------
'--------------------Modified By: James----------------------------
Option Compare Database
Option Explicit

Private Sub Form_Current()
Dim S_FILENAME As String
Dim pos As Integer, Filetype As String

Me.Imagephoto.Visible = False

'Look to see if a path already exists, & then test to see what filetype it is
If Not IsNull(Me.A_IMAGE_PATH) Then
    pos = InStr(Me.A_IMAGE_PATH, ".")
        If pos > 0 Then
            Filetype = Mid(Me.A_IMAGE_PATH, pos + 1)
                If Filetype = "mpg" Then 'If it is an mpeg, display mediaplayer
                    Me.Imagephoto.Visible = False
                    Me.cmdLinkPicture.Visible = False
                Else 'Otherwise display the photoviewer
                    Me.Imagephoto.Visible = True
                    Me.Imagephoto.PictureType = 1
                    Me.cmdLinkPicture.Visible = False
                    If CheckFileExists(Me.A_IMAGE_PATH) = 1 Then
                        Me.Imagephoto.Picture = Me.A_IMAGE_PATH
                        Me.Imagephoto.Picture = "Path to template image"
                    End If
                End If
        End If
Else 'If no path was found, display the template image
    Me.Imagephoto.Visible = True
    Me.Imagephoto.Picture = "path to template image"
    Me.cmdLinkPicture.Visible = True
End If
End Sub

Private Sub OpenBtn_Click()
Call OpenButton
End Sub

Function OpenButton()
On Error GoTo Err_OpenFileBtn_Click
Dim S_FILENAME As String
Dim S_COUNTER As Integer
Dim S_POINTER As Integer


' Step thro the path to determine the directory
If Not IsNull(Me![A_IMAGE_PATH]) Then
    For S_COUNTER = 1 To Len(Me![A_IMAGE_PATH]) Step 1
    If InStr(S_COUNTER, Me![A_IMAGE_PATH], "\", 0) = S_COUNTER Then
    End If
    Next S_COUNTER
End If

' Call the common open file dialog to find a file

' Set the field to the return value
If S_FILENAME <> "" Or Not IsNull(S_FILENAME) Then
    With Me.Imagephoto
        .Picture = S_FILENAME
        .PictureType = 1
    End With
    RunCommand acCmdSaveRecord
End If
If IsNull(S_FILENAME) Then
    S_FILENAME = ""
End If

    Exit Function
    MsgBox Error$
    Resume Exit_OpenFileBtn_Click
End Function

As long as this form has access to the field containing a path to the image, this will display the image (if it actually exists).

Back to Microsoft: Access Modules (VBA Coding) FAQ Index
Back to Microsoft: Access Modules (VBA Coding) Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close