Dan:
Below is my standard reply on this topic. You might find that some lines of
code have been split over two lines in your newsreader, so when pasting the
code into your database watch out for this and remove the unwanted carriage
returns/line feeds if necessary:
Simply store the path to each image in a text column in a table and load it
into an Image control on a form or report at runtime by setting the control's
Picture property to the path.
Here's the code for the class module of a form which does this:
''''module starts''''
Option Compare Database
Option Explicit
Private Sub cmdAddImage_Click()
On Error GoTo Err_Handler
Dim OpenDlg As New BrowseForFileClass
Dim strPath As String
Dim strAdditionalTypes As String, strFileList As String
' grab position of cursor
GrabCursor
' amend the following line for whatever file
' types you wish to use
strFileList = "*.bmp; *.jpg"
strAdditionalTypes = "Image Files (" & strFileList & ") |" & strFileList
' force form to Dirty
Me.ImageTitle = Me.ImageTitle
' open common 'file open' dialogue and get path to selected file
OpenDlg.DialogTitle = "Select Image File"
OpenDlg.AdditionalTypes = strAdditionalTypes
strPath = OpenDlg.GetFileSpec
Set OpenDlg = Nothing
' if file selected then set Picture property of Image control
' to path to file and enable ImageTitle control
If Len(strPath) > 0 Then
Me.ImagePath = strPath
Me.Image1.Picture = strPath
Me.Image1.Visible = True
End If
Exit_here:
' reset cursor position
ReturnCursor
Exit Sub
Err_Handler:
Select Case Err.Number
Case 2001
Resume
Case Else
MsgBox Err.Number, vbExclamation, "Error"
Resume Exit_here
End Select
End Sub
Private Sub cmdDeleteImage_Click()
Me.ImagePath = Null
Me.Image1.Visible = False
End Sub
Private Sub cmdReport_Click()
On Error Resume Next
DoCmd.OpenReport "rptImages", acViewPreview
End Sub
Private Sub Form_Close()
' rsetore database window
DoCmd.SelectObject acForm, Me.Name, True
DoCmd.Restore
End Sub
Private Sub Form_Current()
GrabCursor
If Not IsNull(Me.ImagePath) Then
Me.Image1.Visible = True
Me.Image1.Picture = Me.ImagePath
Else
Me.Image1.Visible = False
End If
ReturnCursor
End Sub
''''module ends''''
And here's the code for a report's class module:
''''module starts''''
Option Compare Database
Option Explicit
Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
If Not IsNull(Me.ImagePath) Then
Me.Image1.Picture = Me.ImagePath
Me.Image1.Visible = True
Else
Me.Image1.Visible = False
End If
End Sub
Private Sub Report_NoData(Cancel As Integer)
MsgBox "No data to report", vbInformation, "Images"
Cancel = True
End Sub
''''module ends''''
Note that in the report there needs to be a control bound to the ImagePath
field so that the above code can reference it. This would normally be hidden
by setting its Visible property to False.
Put the following class module in the database for opening the common
dialogue for browsing to an image file:
''''module starts''''
Option Compare Database
Option Explicit
' Note: This module is a modified copy of part of the modRefreshLinks
' module in the Solutions database that is supplied with Access.
'
' That module in the Solutions database contains a lot of descriptive
' comments about the OPENFILENAME data structure that is used below, and
' it contains definitions for a list of constants that can be used in the
' Flags field in the OPENFILENAME data structure.
'
' This version was created by Bill Wilson in January 1999.
' Modified by Ken Sheridan, May 1999 to allow multiple 'additional types'
'
' The purpose of this class is to activate a dialog box that the User will
' use to pick out a particular file. The VBA code that uses this class can
' either use it to open a file or to just save the complete path and filename
' for a file which will be used at some future time.
'
' NB The dialog does not actually open the file. It only returns the path
' to the file for use in code (comment added by KWS).
'
' There are default values for the dialog box title and the list of file
types
' in the 'file filter' section of the dialog box. The calling VBA code can
' use the following Properties and Methods of this class.
'
' Properties:
' DialogTitle -- the text that is displayed as the title of the
' dialog box. The default is "Browse For a File".
' AdditionalTypes -- one or more additional file types to be added
as
' one item in the dialog box's file filter list,
' formatted like this sample:
' "My Files (*.mf1;*.mf2) | *.mf1;*.mf2 |
Your Files (*.yf1;*.yf2) *.yf1;*.yf2"
' The following file types are in the built-in
list:
' "All Files (*.*)"
' "Text Files (*.txt;*.prn;*.csv)"
' "Word Documents (*.doc)"
' "Word Templates (*.dot)"
' "Rich Text Files (*.rtf)"
' "Excel Files (*.xls)"
' "Databases (*.mdb)"
' "HTML Documents (*.html;*.htm)"
' DefaultType -- the item in the dialog's file filter list that
will be
' active when the dialog box is activated. If the
' AdditionalTypes property is not used, the default
' is "All files (*.*)". If the AdditionalTypes
property
' is used, this property cannot be used and the
file type
' specified in the AdditionalTypes property will be
active
' when the dialog box is activated. To set this
property,
' specify a string that will match with the desired
type,
' such as "*.doc" or "HTML".
' InitialFile -- the file name that is to be displayed in the File
Name
' field in the dialog box when it is activated. The
' default is to leave the File Name field blank.
' InitialDir -- the directory/folder which should be active when the
' dialog box is activated. The default is the current
' directory.
'
' Methods:
' GetFileSpec() -- this function activates the dialog box and then
returns
' the full path and filename of the file that the
User
' has selected. If the User clicks Cancel, a zero
' length string is returned.
'
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter 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
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long
End Type
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Private strDialogTitle As String
Private intDefaultType As Integer
Private strNewTypes As String
Private strInitialFile As String
Private strInitialDir As String
Private strFilter As String
Private strFltrLst As String
Private strFltrCnt As String
' This 'Method' routine displays the Open dialog box for the user to
' locate the desired file. Returns the full path to the file.
'
Public Function GetFileSpec()
Dim of As OPENFILENAME
Dim intRet As Integer
'set up the file filter and the default type option
If strNewTypes <> "" Then
of.lpstrFilter = strNewTypes & strFilter
of.nFilterIndex = 1
Else
of.lpstrFilter = strFilter
If intDefaultType <> 0 Then
of.nFilterIndex = intDefaultType
Else
of.nFilterIndex = 1
End If
End If
'define some other dialog options
of.lpstrTitle = strDialogTitle
of.lpstrInitialDir = strInitialDir
of.lpstrFile = strInitialFile & String(512 - Len(strInitialFile), 0)
of.nMaxFile = 511
' Initialize other parts of the structure
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0
of.lpstrFileTitle = String(512, 0)
of.nMaxFileTitle = 511
of.lpstrDefExt = vbNullChar
of.Flags = 0
of.lStructSize = Len(of)
'call the Open dialog routine
intRet = GetOpenFileName(of)
If intRet Then
GetFileSpec = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
Else
GetFileSpec = ""
End If
End Function 'End of GetFileSpec
'
' The following 'Property' routines define the Dialog Box properties
'
Public Property Let DialogTitle(strTitle As String)
'store the title for the dialog box
strDialogTitle = strTitle
End Property
Public Property Let AdditionalTypes(strAddTypes As String)
Dim Posn As Integer
Dim I As Integer
'don't accept additional types if a default type has
been specified
If intDefaultType <> 0 Then
MsgBox "You cannot add to the file type filter if a default type is
" & _
"being specified in the DefaultType property. When the " & _
"AdditionalTypes property is used, that item " & _
"is used as the default in the file type filter.",
vbCritical, _
"Browse For File Dialog"
Exit Property
End If
'check for the "|" delimiter
Posn = InStr(strAddTypes, "|")
'save the new parameter or report an error
If Posn = 0 Then
MsgBox "The AdditionalTypes property string does not contain at
least " & _
"one " & Chr$(34) & "|" & Chr$(34) & " character. " & _
"You must specify an AdditionalTypes property in the same "
& _
"format that is shown in the " & _
"following example: " & vbCrLf & vbCrLf & Chr$(34) & _
"My Files (*.mf1;*.mf2) | *.mf1;*.mf2 | Your Files
(*.yf1;*.yf2) *.yf1;*.yf2" _
& Chr$(34), vbCritical, "Browse For File Dialog"
strNewTypes = ""
Exit Property
Else
Do While True
If InStr(1, strAddTypes, "|") Then
strNewTypes = strNewTypes & Left$(strAddTypes, _
InStr(1, strAddTypes, "|") - 1) & vbNullChar
strAddTypes = Mid$(strAddTypes, InStr(1, strAddTypes, "|") +
1)
Else
strNewTypes = strNewTypes & strAddTypes & vbNullChar
Exit Do
End If
Loop
End If
End Property 'End of AdditionalTypes
Public Property Let DefaultType(strType As String)
Dim Posn As Integer
Posn = InStr(strFltrLst, strType)
'don't accept a default if new types are being specified
If strNewTypes <> "" Then
MsgBox "You cannot set the DefaultType property if you are using the
" & _
"AdditionalTypes property to expand the file types filter.
" & _
"In that case the type specified in the AdditionalTypes
property " & _
"will be the default type.", vbCritical, "Browse For File
Dialog"
Exit Property
'make sure the selected default actually exists
ElseIf Posn = 0 Then
MsgBox "The file type you specified in the DefaultType " & _
"property is not in the built-in " & _
"list of file types. You must either specify one of the " & _
"built-in file types or use the AdditionalTypes property " & _
"to specify a complete entry similar to the " & _
"following example: " & vbCrLf & vbCrLf & Chr$(34) & _
"My Files (*.mf) | *.mf" & Chr$(34), vbCritical, _
"Browse For File Dialog"
Exit Property
Else
'set up the selected default
intDefaultType = Trim$(Mid$(strFltrCnt, Posn, 3))
End If
End Property
Public Property Let InitialFile(strIFile As String)
strInitialFile = strIFile
End Property
Public Property Let InitialDir(strIDir As String)
strInitialDir = strIDir
End Property
' This routine initializes the string constants that are used by this class
'
Private Sub Class_Initialize()
'define some initial conditions
strDialogTitle = "Browse For a File"
strInitialDir = ""
strInitialFile = ""
strNewTypes = ""
'define the filter string and the look-up strings
strFilter = "All Files (*.*)" & vbNullChar & "*.*" & vbNullChar & _
"Text Files (*.txt;*.prn;*.csv)" & vbNullChar &
"*.txt;*.prn;*.csv" & vbNullChar & _
"Word Documents (*.doc)" & vbNullChar & "*.doc" & vbNullChar
& _
"Word Templates (*.dot)" & vbNullChar & "*.dot" & vbNullChar
& _
"Rich Text Files (*.rtf)" & vbNullChar & "*.rtf" &
vbNullChar & _
"Excel Files (*.xls)" & vbNullChar & "*.xls" & vbNullChar & _
"Databases (*.mdb)" & vbNullChar & "*.mdb" & vbNullChar & _
"HTML Documents (*.html;*.htm)" & vbNullChar &
"*.html;*.htm" & vbNullChar
strFltrLst = "*.* *.txt *.prn *.csv *.doc *.dot *.rtf *.xls *.mdb *.html"
strFltrCnt = " 1 2 2 2 3 4 5 6 7 8 "
End Sub
''''module ends''''
Finally the following standard module should also be put in the database to
move the cursor back to its original position after inserting a new image
path:
''''module starts''''
Option Compare Database
Option Explicit
Type POINTAPI
X As Long
Y As Long
End Type
Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
Declare Function SetCursorPos Lib "User32" (ByVal X As Long, ByVal Y As
Long) As Long
Public lngCursorX As Long, lngCursorY As Long
Public Sub GrabCursor()
Dim dl As Long
Dim pt As POINTAPI
dl = GetCursorPos(pt)
lngCursorX = pt.X
lngCursorY = pt.Y
End Sub
Public Sub ReturnCursor()
SetCursorPos lngCursorX, lngCursorY
End Sub
''''module ends''''
If you have any difficulty implementing the above I can send it to you as a
demo file if you mail me at kenwsheridan<at>yahoo<dot>co<dot>uk.
Ken Sheridan
Stafford, England
