How do I display images within access, storing only the path?

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:[color blue]
'------------------------------------------------------------------
'----------------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[/color]

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:
[color blue]
'------------------------------------------------------------------
'----------------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[/color]


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).