INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS
Come Join Us!
- Talk With Other Members
- Be Notified Of Responses
To Your Posts
- Keyword Search
- Turn Off Ad Banners
- 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.
Partner With Us!
"Best Of Breed" Forums Add Stickiness To Your Site
(Download This Button Today!)
Member Feedback
"Because of this forum, I continue to WOW! my clients!"
Geography
Where in the world do Tek-Tips members come from?
|
Microsoft: Access Modules (VBA Coding) FAQ
|
Using Images
|
How do I display images within access, storing only the path?
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 FAQ Archive
 Email This FAQ To A Friend |
|
 |
|
Talk To Other Members