i've got a little 'add image' problem too... (1 Viewer)

wiklendt · Aug 19, 2008

Hi everyone,

A) this is something i didn't bother with for some time, but i think i need to sort it out. when i add an image path to my table via a browse button on my form - all is good. however, if i click on my 'add image' button, browse for an image, then decide the one i have is the best one after all so i click 'cancel' in the browse dialog, the image that was there originally is removed form the table (and the next time i open the form the image is no longer displayed).

my work-around at the moment is to remove the image from displaying b/c the entry in the table was deleted anyway. this alerts the users straightaway to the fact that the image is gone. if i remove the error handling for this event, i get an error message saying "Error # 13: type mismatch"

here is the code i am using on my browse button on my form (i have 7 in total, all are the same save the appropriate field names etc for each one...):

Code:

Private Sub cmdBrowseHorsePhoto3_Click()
On Error GoTo err_cmdBrowseHorsePhoto3

    Dim strDialogTitle As String
    strDialogTitle = "Select a left view image for " & Me!FormHorseName
    Me![HorsePhotoLeft] = GetOpenFile_CLT(".\", strDialogTitle)
    Me![HorsePhotoLeft] = LCase(Me![HorsePhotoLeft])
    Me!imgHorsePhoto3.Picture = Me!HorsePhotoLeft

exit_cmdBrowseHorsePhoto3:
    Exit Sub
    
err_cmdBrowseHorsePhoto3:
    Select Case Err.Number
       Case 13
        'ignore, not an Error(?), but remove current for now, b/c "select image" deleted what was there anyway
        Me!imgHorsePhoto3.Picture = ""
       Case Else
        Msg = "Error # " & Str(Err.Number) & Chr(13) & Err.Description
        MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
        End Select
    Resume exit_cmdBrowseHorsePhoto3

End Sub

and this is my basOpenFile module code (i'll paste it all b/c i'm not sure which bits are the important ones - although i suspect it could have something to do with the bit i've highlighted in red)

Code:

Option Compare Database
Option Explicit
' Code for this module was taken from a "PictDatabse 2000" sample database. Author unknown.
' Declarations for Windows Common Dialogs procedures
Private Type CLTAPI_OPENFILE
  strFilter As String             ' Filter string
  intFilterIndex As Long          ' Initial Filter to display.
  strInitialDir As String         ' Initial directory for the dialog to open in.
  strInitialFile As String        ' Initial file name to populate the dialog with.
  strDialogTitle As String        ' Dialog title
  strDefaultExtension As String   ' Default extension to append to file if user didn't specify one.
  lngFlags As Long                ' Flags (see constant list) to be used.
  strFullPathReturned As String   ' Full path of file picked.
  strFileNameReturned As String   ' File name of file picked.
  intFileOffset As Integer        ' Offset in full path (strFullPathReturned) where the file name (strFileNameReturned) begins.
  intFileExtension As Integer     ' Offset in full path (strFullPathReturned) where the file extension begins.
End Type

Const ALLFILES = "All Files"

Private Type CLTAPI_WINOPENFILENAME
    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    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 String
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Declare Function CLTAPI_GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
  (pOpenfilename As CLTAPI_WINOPENFILENAME) _
As Boolean
  
Declare Function CLTAPI_GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
  (pOpenfilename As CLTAPI_WINOPENFILENAME) _
As Boolean
  
Declare Sub CLTAPI_ChooseColor Lib "msaccess.exe" Alias "#53" _
  (ByVal hwnd As Long, rgb As Long)

Function GetOpenFile_CLT(strInitialDir As String, strTitle As String) As String
  ' Comments  : Simple file open routine. For additional options, use GetFileOpenEX_CLT()
  ' Parameters: strInitialDir - path for the initial directory, or blank for the current directory
  '             strTitle - title for the dialog
  ' Returns   : string path, name and extension of the file selected
  '
  Dim fOK As Boolean
  Dim typWinOpen As CLTAPI_WINOPENFILENAME
  Dim typOpenFile As CLTAPI_OPENFILE
  Dim strFilter As String
  
  On Error GoTo PROC_ERR
  
  ' Set reasonable defaults for the structure
  
  strFilter = CreateFilterString_CLT("JPEG files (*.JPG)", "*.JPG", "GIF image files (*.GIF)", "*.GIF", "Bitmap files (*.BMP)", "*.BMP")
  ' strFilter = CreateFilterString_CLT("JPEG image files (*.JPG)", "*.JPG", "GIF image files (*.GIF)", "*.GIF")
  '(original in the above line)
  ' to add more, use same format separated by commas within the CLT()
  ' e.g.: All Files (*.*)", "*.*",
  
  If strInitialDir <> "" Then
    typOpenFile.strInitialDir = strInitialDir
  Else
    typOpenFile.strInitialDir = CurDir()
  End If
  
  If strTitle <> "" Then
    typOpenFile.strDialogTitle = strTitle
  End If
  
  typOpenFile.strFilter = strFilter
  typOpenFile.lngFlags = OFN_HIDEREADONLY Or OFN_SHOWHELP
  
  ' Convert the CLT structure to a Win structure
  ConvertCLT2Win typOpenFile, typWinOpen
  
  ' Call the Common dialog
  fOK = CLTAPI_GetOpenFileName(typWinOpen)
  
  ' Convert the Win structure back to a CLT structure
  ConvertWin2CLT typWinOpen, typOpenFile
  
  GetOpenFile_CLT = typOpenFile.strFullPathReturned
      
PROC_EXIT:
  Exit Function
  
[COLOR=Red]PROC_ERR:
  GetOpenFile_CLT = ""
  Resume PROC_EXIT[/COLOR]

End Function

Sub ConvertCLT2Win(CLT_Struct As CLTAPI_OPENFILE, Win_Struct As CLTAPI_WINOPENFILENAME)
  ' Comments  : Converts the passed CLTAPI structure to a Windows structure
  ' Parameters: CLT_Struct - record of type CLTAPI_OPENFILE
  '             Win_Struct - record of type CLTAPI_WINOPENFILENAME
  ' Returns   : Nothing
  '
  Dim strFile As String * 512

  On Error GoTo PROC_ERR
  
  Win_Struct.hWndOwner = Application.hWndAccessApp
  Win_Struct.hInstance = 0

  If CLT_Struct.strFilter = "" Then
    Win_Struct.lpstrFilter = ALLFILES & Chr$(0) & "*.*" & Chr$(0)
  Else
    Win_Struct.lpstrFilter = CLT_Struct.strFilter
  End If
  Win_Struct.nFilterIndex = CLT_Struct.intFilterIndex

  Win_Struct.lpstrFile = String(512, 0)
  Win_Struct.nMaxFile = 511
  
  Win_Struct.lpstrFileTitle = String$(512, 0)
  Win_Struct.nMaxFileTitle = 511

  Win_Struct.lpstrTitle = CLT_Struct.strDialogTitle
  Win_Struct.lpstrInitialDir = CLT_Struct.strInitialDir
  Win_Struct.lpstrDefExt = CLT_Struct.strDefaultExtension

  Win_Struct.Flags = CLT_Struct.lngFlags

  Win_Struct.lStructSize = Len(Win_Struct)
  
PROC_EXIT:
  Exit Sub
  
PROC_ERR:
  Resume PROC_EXIT
   
End Sub

Sub ConvertWin2CLT(Win_Struct As CLTAPI_WINOPENFILENAME, CLT_Struct As CLTAPI_OPENFILE)
  ' Comments  : Converts the passed CLTAPI structure to a Windows structure
  ' Parameters: Win_Struct - record of type CLTAPI_WINOPENFILENAME
  '             CLT_Struct - record of type CLTAPI_OPENFILE
  ' Returns   : Nothing
  '
  On Error GoTo PROC_ERR
      
  CLT_Struct.strFullPathReturned = Left(Win_Struct.lpstrFile, InStr(Win_Struct.lpstrFile, vbNullChar) - 1)
  CLT_Struct.strFileNameReturned = RemoveNulls_CLT(Win_Struct.lpstrFileTitle)
  CLT_Struct.intFileOffset = Win_Struct.nFileOffset
  CLT_Struct.intFileExtension = Win_Struct.nFileExtension
  
PROC_EXIT:
  Exit Sub
  
PROC_ERR:
  Resume PROC_EXIT
  
End Sub

Function CreateFilterString_CLT(ParamArray varFilt() As Variant) As String
  ' Comments  : Builds a Windows formatted filter string for "file type"
  ' Parameters: varFilter - parameter array in the format:
  '                          Text, Filter, Text, Filter ...
  '                         Such as:
  '                          "All Files (*.*)", "*.*", "Text Files (*.TXT)", "*.TXT"
  ' Returns   : windows formatted filter string
  '
  Dim strFilter As String
  Dim intCounter As Integer
  Dim intParamCount As Integer

  On Error GoTo PROC_ERR
  
  ' Get the count of paramaters passed to the function
  intParamCount = UBound(varFilt)
  
  If (intParamCount <> -1) Then
    
    ' Count through each parameter
    For intCounter = 0 To intParamCount
      strFilter = strFilter & varFilt(intCounter) & Chr$(0)
    Next
    
    ' Check for an even number of parameters
    If (intParamCount Mod 2) = 0 Then
      strFilter = strFilter & "*.*" & Chr$(0)
    End If
    
  End If

  CreateFilterString_CLT = strFilter
  
PROC_EXIT:
  Exit Function
  
PROC_ERR:
  CreateFilterString_CLT = ""
  Resume PROC_EXIT
  
End Function

Function RemoveNulls_CLT(strIn As String) As String
  ' Comments  : Removes terminator from a string
  ' Parameters: strIn - string to modify
  ' Return    : modified string
  '
  Dim intChr As Integer

  intChr = InStr(strIn, Chr$(0))

  If intChr > 0 Then
    RemoveNulls_CLT = Left$(strIn, intChr - 1)
  Else
    RemoveNulls_CLT = strIn
  End If

End Function

some other things i wanted to tackle with this code (though one step at a time!) is that

B) relative path returned

the code above returns an absolute path, not relative... i have fiddled with commenting out bits of code in the basOpenFile, and also changing bits, but none of it worked. (and i have changed it back to absolute path).

is there something simple i can do to achieve this (retaining my browse button and dialog - i refuse to force my users to know how compile an absoulte path to their image and then typing it in!)

this will also help if my user needs to move the database from desktop to laptop while out on assignment. i HAVE looked at all the current options on this forum and on internet, but they all have EITHER a browse dialog OR relative path (via manual typing in of text). the means to the end are so vastly different.

C) copy and rename

this database has sub-folders. one i have called HorsePhotos. is it possible at all, that when a user chooses an image from somewhere in their computer, Access, through VBA(?) copies and renames that image into "./HorsePhotos/[appropriate name change].jpg/gif/bmp" and returns that as a relative path? WHILST RETAINING THE BROWSE BUTTON FOR SELECTING AN IMAGE.

the 'copying' assures that the image chosen is always available even if the user deletes the original one they chose (say they forget that's the one they used OR they re-organise the Pictures folder, whatever) because the copy is safely stored in the sub-folder of the database. also means the database is easily migrated.

the 'renaming' assures that the folder doesn't keep growing and growing and growing if the user changes one image several times for the same horse.

mikebaldam · Aug 19, 2008

How about storing the orignal value at the start and on clicking cancel, replacing it?

wiklendt · Aug 19, 2008

wow - that's a very good idea mikebaldam! i'll look into that - nice'n'simple. ;-) (why didn't i think of that!?)

wiklendt · Oct 9, 2008

ok, i've finally started trying to tackle this issue somewhat seriously. i have tried storing the data first, then reapplying it when the user cancels. i've tried using code i've found online and forums, but not sure i'm using the right keywords b/c i often get unrelated hits or nothing. (using keywords "invalid use of null" and "passing variable" and "temporary variable")

so the browse button should open a dialog to search for a file (which it does) and displays the new photo on the form when selected, but if the user cancels, it returns the old photo. however, if i have changed the image a few times, and then decide to click cancel on the, say, fourth change, the database returns the VERY ORIGINAL photo that was there (before the other three changes) - EVEN IF i close the form and reopen.

i have also added complexity to this by adding a "remove" button on the form for the user... the idea of this is basically to remove the data from the field of that record and also removes the image from display. and i have also tried to implement the 'in case user cancels' (when user presses button, msgbox pops up and asks whether user is sure, with yes/no) and here is the effect:

when i remove a photo, all good, removes. if i click cancel, the ORIGINAL image (despite how many times it was changed) is restored to the field. HOWEVER, if i DO remove a photo, and THEN want to browse to add a new photo, i get error 94: invalid use of null.

now, i have tried to sort of get around this, but have been unsuccessful - here is my code: am i missing something?

Browse button

Code:

Private Sub cmdBrowseHorsePhoto1_Click()
On Error GoTo err_cmdBrowseHorsePhoto1

    Dim strDialogTitle As String
    Dim PhotoTemp As String
        
    ' save the current image in case user changes mind
    PhotoTemp = Me![HorsePhotoFront]
    
    strDialogTitle = "Select a front view image for " & Me!FormHorseName
    Me!HorsePhotoFront = GetOpenFile_CLT(".\", strDialogTitle)
    Me!HorsePhotoFront = LCase(Me!HorsePhotoFront)
    Me!imgHorsePhoto1.Picture = Me!HorsePhotoFront
    ' update the temp
    PhotoTemp = Me!HorsePhotoFront

exit_cmdBrowseHorsePhoto1:
    Exit Sub
    
err_cmdBrowseHorsePhoto1:
    Select Case Err.Number
       Case 13
        'restore image that was there before user clicked 'browse'
        Me!HorsePhotoFront = PhotoTemp
        Me!imgHorsePhoto1.Picture = Me!HorsePhotoFront
        PhotoTemp = Me!HorsePhotoFront
       
       Case Else
        Msg = "Error # " & Str(Err.Number) & Chr(13) & Err.Description
        MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
        End Select
    Resume exit_cmdBrowseHorsePhoto1

End Sub

Remove button

Code:

Private Sub cmdRemoveHorsePhoto1_Click()

On Error GoTo Err_cmdRemoveHorsePhoto1_Click

    Dim PhotoTemp As String
    Dim Msg, Style, Title, Help, Ctxt, Response, MyString

    ' save the current image in case user changes mind
    PhotoTemp = Me!HorsePhoto

    ' =====================================================
    Msg = "Remove image? (Does not delete from computer)"
    Style = vbYesNo + vbCritical + vbDefaultButton2
    Title = "The Professional Equine Database"
    Response = MsgBox(Msg, Style, Title)
    
    If Response = vbYes Then
        'user wants to delete - remove photo
        Me![HorsePhotoFront] = ""
        Me!imgHorsePhoto1.Picture = ""
    Else
        'user wants to keep, restore originial
        Me![HorsePhotoFront] = PhotoTemp
        Me!imgHorsePhoto1.Picture = Me![HorsePhotoFront]
    End If
    ' =====================================================

Exit_cmdRemoveHorsePhoto1_Click:
    Exit Sub

Err_cmdRemoveHorsePhoto1_Click:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Exit_cmdRemoveHorsePhoto1_Click

End Sub

i have a total of eight images on this form, each has its own code (they only differ by HorsePhoto# and HorsePhotoLOCATION. perhaps my problem is that i'm using "PhotoTemp" in each one? but i don't think so b/c each image field restores its own original (HorsePhotoBack will restore only the original Back image, not, say, Front image, which is the first in the code).

i was thinking maybe in need to reset the variable somehow, which is what i've tried to do in the code but it feels... ...just wrong, somehow.

CyberLynx · Oct 9, 2008

Let's start at the beginning here.

You have a Form which is obviously displaying a partcular image where the path to that image i stored within a Table. You want to see if there is a better image so you browse the system and start selecting images to see what they look like. In the process you now loose the path to the original image that was in table.

There are several ways to take care of this situation. The easiest would be to set the file browser to display Thumbnails. Now you can preview them before even selectng them.

If there is a little more you would like to do to take care of this then:

Declare a Form wide Variant variable within the Declarations section of the Forms' code module. Perhaps name it OriginalImagePath, like this:

Code:

Option Compare Database
Option Explicit

Dim OriginalImagePath As Variant

Within the OnCurrent event of your Form perhaps have something like this:

Code:

OriginalImagePath = Nz(Me.[HorsePhotoLeft], "")

Now the code in your Browse button OnClick event should look something like this:

Code:

Private Sub cmdBrowseHorsePhoto3_Click()
   On Error GoTo err_cmdBrowseHorsePhoto3
   
   Dim strDialogTitle As String
   Dim PathStrg As String
   Dim Msg As String

   [COLOR="DarkGreen"]'Every time the Browse button is selected, the original Image
   'is placed back into the HorsePhotoLeft TextBox. The OriginalImagePath 
   'variable is always updated by the Forms' OnCurrent event while
   'scrolling through records.[/COLOR]
   If Nz(OriginalImagePath, "") <> "" Then Me![HorsePhotoLeft] = OriginalImagePath

   strDialogTitle = "Select a left view image for " & Me!FormHorseName
   
   [COLOR="DarkGreen"]'Browse for file. Place the selected File into the PathStrg Variable.[/COLOR] 
   PathStrg = GetOpenFile_CLT(".\", strDialogTitle)

   [COLOR="DarkGreen"]'If no file was selected then the PatStrg variable will be empty.
   'If there was a file selected then.....[/COLOR]
   If PathStrg <> "" Then
      Me![HorsePhotoLeft] = LCase(PathStrg)
      Me!imgHorsePhoto3.Picture = Me!HorsePhotoLeft
   End If

exit_cmdBrowseHorsePhoto3:
   Exit Sub
    
err_cmdBrowseHorsePhoto3:
   Msg = "Error # " & Str(Err.Number) & Chr(13) & Err.Description
   MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
   Resume exit_cmdBrowseHorsePhoto3
End Sub

Give that a try (if you like).

.

wiklendt · Oct 10, 2008

Wow, CyberLynx, thanks for that!

i've begun to implement your suggestions and it works a treat. and i've learnt about Nz!! always wondered about that but never could get around the examples i've seen on the forums b/c the sample data was so different to what i had (access help actually helped this time!)

having said that i will have to add null value management to the 'remove' button, but i think you've given me the tools to deal with that now :-D

you're a champ

wiklendt · Dec 17, 2008

Hi everyone,

i thought i'd post here some modifications i've made recently to this code. i don't know that it's elegant, but it works

in my db, i wanted to make sure that the images for each horse would be there for access to find (even if the user accidentally deletes or moves their image) by using VBA to copy the file and place it in a subfolder of the database.

also, if i/the user ever wanted to move the db to a different location, so long as they take the whole db folder (including subfolders) i'm sure this will work like a dream (not yet tested!).

it uses the UniqueID (autonumber; PK) to rename the file. i wanted to avoid using the horse name for the image in case user changes the name for whatever reason - and also this updates the path in the appropriate table, in a relative manner so it also reduces bytes stored in tables.

this method replaces any previous image copied so that there isn't uneccessary overbloating of bytes used on the user's computer.

(LOL and you know, it took me a while to realise why my "CopyFile" wasn't working... it is supposed to be "FileCopy'!! ah, those silly mistakes....)

i haven't tested this on a server/network settings, and i'm pretty damn sure it WON'T work in that environment, but i'm not ever really expecting this db to be used in such a manner. anyway, here's the modified code (in red).

Code:

Private Sub cmdBrowseHorsePhoto0_Click()
On Error GoTo err_cmdBrowseHorsePhoto0

   Dim strDialogTitle As String
   Dim PathStrg As String
   Dim Msg As String
   
[COLOR=Red]   Dim relativePath As String
   Dim dbPath As String
[/COLOR] 
[COLOR=SeaGreen]   'Every time the Browse button is selected, the original Image
   'is placed back into the HorsePhotoLeft TextBox. The OriginalImagePath
   'variable is always updated by the Forms' OnCurrent event while
   'scrolling through records.
[/COLOR]   If Nz(OriginalImagePath0, "") <> "" Then Me![HorsePhoto] = OriginalImagePath0

   strDialogTitle = "Select a front view image for " & Me!FormHorseName
   
[COLOR=SeaGreen]   'Browse for file. Place the selected File into the PathStrg Variable.
[/COLOR]   PathStrg = GetOpenFile_CLT(".\", strDialogTitle)

[COLOR=SeaGreen]   'If no file was selected then the PatStrg variable will be empty.
   'If there was a file selected then.....
[/COLOR]   If PathStrg <> "" Then
[COLOR=SeaGreen]      'these next two lines were used before i used the relativePath FileCopy method
      'Me![HorsePhoto] = LCase(PathStrg)
      'Me!imgHorsePhoto0.Picture = Me!HorsePhoto
[/COLOR]            
[COLOR=SeaGreen]      'Now that we have an image that the user wants, save this image
      'into a subfolder of the database, replacing any previous image
      'for this field that is there.
      
        'first we declare where the current database is
        'and where we want the image (a subfolder of the db)
[/COLOR] [COLOR=Red]       relativePath = "\HorsePhotos\" & Me.ID & "_Photo_0.jpg"
        dbPath = Application.CurrentProject.Path
[/COLOR]      
[COLOR=SeaGreen]        'now the copy command
[/COLOR] [COLOR=Red]       FileCopy LCase(PathStrg), dbPath & relativePath
[/COLOR]      
[COLOR=SeaGreen]        'now make sure the newly copied image is the one saved in the table
        'this ensures the image will still be available in the instances that:
            'a) the original image is moved or accidentally deleted
            'b) the database is moved (with subfolders) to a new location (NOT server/network)
[/COLOR] [COLOR=Red]       Me!HorsePhoto.Value = relativePath
        Me!imgHorsePhoto0.Picture = dbPath & relativePath
[/COLOR]      
   End If

exit_cmdBrowseHorsePhoto0:
    Exit Sub
    
err_cmdBrowseHorsePhoto0:
        Msg = "Error # " & Str(Err.Number) & Chr(13) & Err.Description
        MsgBox Msg, vbOKOnly, "The PED", Err.HelpFile, Err.HelpContext
    Resume exit_cmdBrowseHorsePhoto0

End Sub

CyberLynx · Dec 22, 2008

Great Job wiklendt.

I'm certain your solution will help many others in the time to come. Thanks for posting.

.

i've got a little 'add image' problem too... (1 Viewer)

wiklendt

i recommend chocolate

mikebaldam

Registered User.

wiklendt

i recommend chocolate

wiklendt

i recommend chocolate

CyberLynx

Stuck On My Opinions

wiklendt

i recommend chocolate

wiklendt

i recommend chocolate

CyberLynx

Stuck On My Opinions

Similar threads

Users who are viewing this thread