INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

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.

Jobs

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
    Type OPENFILENAME
         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
    Type OFSTRUCT
        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
        Else
            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
GetOpenFile_Exit:
Exit Function

GetOpenFile_Err:
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
    

chkFinish:
    chkOpen = continue
    Exit Function
    
chkOpenErr:
    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
                    Else
                        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
Me.Refresh
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_INITIALDIR As String
Dim S_COUNTER As Integer
Dim S_POINTER As Integer

S_POINTER = 0

' 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
        S_POINTER = S_COUNTER
    End If
    Next S_COUNTER
    S_INITIALDIR = Left(Me![A_IMAGE_PATH], S_POINTER)
End If

' Call the common open file dialog to find a file
S_FILENAME = GetOpenFile(IIf(IsNull(S_INITIALDIR), "C:\", S_INITIALDIR))

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





Exit_OpenFileBtn_Click:
    Exit Function
    
Err_OpenFileBtn_Click:
    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

Resources

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