
The function I need is the Photo function that allows for adding and updating the Employee photo in the Employee Form. I have tried copying the code in the functions and Modules section and duplicate the buttons (I used Different names but adjusted the code accordingly). After several hours of getting the error "Variable Undefined" for the argument (msoFileDialogFilePicker) in the "Sub getFileName()" section I found that problem and corrected for it.
Now the code shows unsupported function or action for the "If",Marked in Bold and Underlined in this post, statement just below that and when I comment that section out the code runs and it shows me the Access File Open window in the correct Directory but no matter what I do I can't select a file by clicking or double clicking or even typing the file name in. I can right click the image frame and select the correct picture using the function in the drop down list but that is the only way I can do it and I can't depend on the users who will be using it to do this process correctly.
Here is the code I have so far:
Module 1:
Code:
Option Compare Database
Option Explicit
Public Function DisplayImage(ctlImageControl As Control, strImagePath As Variant) As String
On Error GoTo Err_DisplayImage
Dim strResult As String
Dim strDatabasePath As String
Dim intSlashLocation As Integer
With ctlImageControl
If IsNull(strImagePath) Then
.Visible = False
strResult = "No image name specified."
Else
If InStr(1, strImagePath, "\") = 0 Then
' Path is relative
strDatabasePath = CurrentProject.FullName
intSlashLocation = InStrRev(strDatabasePath, "\", Len(strDatabasePath))
strDatabasePath = Left(strDatabasePath, intSlashLocation)
strImagePath = strDatabasePath & strImagePath
End If
.Visible = True
.Picture = strImagePath
strResult = "Image found and displayed."
End If
End With
Exit_DisplayImage:
DisplayImage = strResult
Exit Function
Err_DisplayImage:
Select Case Err.Number
Case 2220 ' Can't find the picture.
ctlImageControl.Visible = False
strResult = "Can't find image in the specified name."
Resume Exit_DisplayImage:
Case Else ' Some other error.
MsgBox Err.Number & " " & Err.Description
strResult = "An error occurred displaying image."
Resume Exit_DisplayImage:
End Select
End Function
form New Employee Functions:
Code:
Option Compare Database
Option Explicit
Dim path As String
Private Sub Save_Click()
On Error GoTo Err_Save_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Exit_Save_Click:
Exit Sub
Err_Save_Click:
MsgBox Err.Description
Resume Exit_Save_Click
End Sub
Private Sub AddPicture_Click()
' Use the Office File Open dialog to get a file name to use
' as an employee picture.
getFileName
End Sub
Private Sub Form_RecordExit(Cancel As Integer)
' Hide the errormsg label to reduce flashing when navigating
' between records.
errormsg.Visible = False
End Sub
Private Sub RemovePicture_Click()
' Clear the file name for the employee record and display the
' errormsg label.
Me![ImagePath] = ""
hideImageFrame
errormsg.Visible = True
End Sub
Private Sub Form_AfterUpdate()
' Requery the ReportsTo combo box after a record has been changed.
' Then, either show the errormsg label if no file name exists for
' the employee record or display the image if there is a file name that
' exists.
Me!ReportsTo.Requery
On Error Resume Next
showErrorMessage
showImageFrame
If (IsRelative(Me!ImagePath) = True) Then
Me![ImageFrame].Picture = path & Me![ImagePath]
Else
Me![ImageFrame].Picture = Me![ImagePath]
End If
End Sub
Private Sub ImagePath_AfterUpdate()
' After selecting an image for the employee, display it.
On Error Resume Next
showErrorMessage
showImageFrame
If (IsRelative(Me!ImagePath) = True) Then
Me![ImageFrame].Picture = path & Me![ImagePath]
Else
Me![ImageFrame].Picture = Me![ImagePath]
End If
End Sub
Private Sub Form_Current()
' Display the picture for the current employee record if the image
' exists. If the file name no longer exists or the file name was blank
' for the current employee, set the errormsg label caption to the
' appropriate message.
Dim res As Boolean
Dim fName As String
path = CurrentProject.path
On Error Resume Next
errormsg.Visible = False
If Not IsNull(Me!Photo) Then
res = IsRelative(Me!Photo)
fName = Me![ImagePath]
If (res = True) Then
fName = path & "\" & fName
End If
Me![ImageFrame].Picture = fName
showImageFrame
Me.PaintPalette = Me![ImageFrame].ObjectPalette
If (Me![ImageFrame].Picture <> fName) Then
hideImageFrame
errormsg.Caption = "Picture not found"
errormsg.Visible = True
End If
Else
hideImageFrame
errormsg.Caption = "Click Add/Change to add picture"
errormsg.Visible = True
End If
End Sub
Sub getFileName()
' Displays the Office File Open dialog to choose a file name
' for the current employee record. If the user selects a file
' display it in the image control.
Dim fileName As String
Dim result As Integer
With Application.FileDialog(msofileDialogFilePicker)
.Title = "Select Employee Picture"
.Filters.Add "All Files", "*.*"
.Filters.Add "JPEGs", "*.jpg"
.Filters.Add "Bitmaps", "*.bmp"
.FilterIndex = 3
.AllowMultiSelect = False
.InitialFileName = CurrentProject.path
result = .Show
[U][B] If (result <> 0) Then
fileName = Trim(.SelectedItems.Item(1))
Me![ImagePath].Visible = True
Me![ImagePath].SetFocus
Me![ImagePath].Text = fileName
Me![FirstName].SetFocus
Me![ImagePath].Visible = False
End If[/B][/U]
End With
End Sub
Sub showErrorMessage()
' Display the errormsg label if the image file is not available.
If Not IsNull(Me!Photo) Then
errormsg.Visible = False
Else
errormsg.Visible = True
End If
End Sub
Function IsRelative(fName As String) As Boolean
' Return false if the file name contains a drive or UNC path
IsRelative = (InStr(1, fName, ":") = 0) And (InStr(1, fName, "\\") = 0)
End Function
Sub hideImageFrame()
' Hide the image control
Me![ImageFrame].Visible = False
End Sub