Private Sub Uploader_Click()
'Add/edit/remove photo
On Error GoTo Err_Handler
'DISABLED for this example
' MsgBox "Feature has been disabled for this example", vbInformation, "Not Available"
'==========================================
'check if photo already assigned
strSelection = Nz(DLookup("Photo", "Person", "ID = " & Me.ID), "")
If strSelection <> "" Then
If MsgBox("Are you sure you want to remove the existing photo?", vbQuestion + vbYesNo, "No photo chosen") _
= vbYes Then
CurrentDb.Execute "UPDATE Person" & _
" SET Person.Photo = Null, Person.PhotoAvailable = False" & _
" WHERE (((Person.ID)=" & [Forms]![Person].[ID] & "));"
Me.Requery
Exit Sub
Else
' 'no code here
End If
End If
'==========================================
End Sub
'==========================================
'CR 28/08/2015 - Code rewritten to ensure compatibility with 64-bit Office
'add new photo
' Set options for the dialog box.
Dim F As FileDialog
Set F = Application.FileDialog(msoFileDialogFilePicker)
F.Title = "Locate the photo file and click on 'Open'"
' Clear out the current filters, and add our own.
F.Filters.Clear
F.Filters.Add "Image files", "*.bmp; *.jpg; *.png"
' Set the start folder
If Me.Photo <> "" Then
F.InitialFileName = GetPathWithoutFilename(Me.Photo)
Else
F.InitialFileName = CurrentProject.Path & "\Photos"
End If
' Call the Open dialog routine.
F.Show
' Return the path and file name.
strFilePath = F.SelectedItems(1)
Debug.Print strFilePath
' Dim strSQL As String
'Update file path
If strFilePath <> "" Then
CurrentDb.Execute "UPDATE Person" & _
" SET Person.Photo = '" & GetFilePath & "', Person.PhotoAvailable = True" & _
" WHERE (((Person.ID)=" & [Forms]![Person].[ID] & "));"
End If
Me.Requery
Exit_Handler:
Exit Sub
Err_Handler:
'if err.number=5,user clicked cancel
If Err.Number <> 5 Then
MsgBox "Error " & Err.Number & " " & Err.Description
End If
Resume Exit_Handler
End Sub