Dbl Click function to select file path and then save that path in another field

[Yatiman Idara]

Hi everyone

I do apologize for asking too many questions over the last few days but I am almost in the final stages of my program and navigating unchartered territory

Basically I have set up a simple function for displaying images.

I have stored the imagepath in a text field and then used an image control (with controlsource set to the field containing the image path)

What i would like now is to set up the following ability:

Customer double clicks on the imagecontrol. File Dialog opens up. They browse to the folder containing the pictures (obviously filter to only show image formats would be nice) and select the image file relating to that record.

The path of this selected image is retrieved and stored as the new value of the imagepath field.

I have seen a few functions to achieve this but they appear too complicated. I think it might be possile to achieve this by simply using a FileDialog. I found this one function on from a sample and tampered around with it but with no success. Sample code is below:

'Opens a File Dialog Picker window and returns the full path of the selected file
Function SelectFile(Optional ByVal Filter As Integer = 1, _
Optional ByVal title As String = "Select file") As String

Dim fso As Object
Set fso = CreateObject("scripting.filesystemobject")

With Application.FileDialog(3) '3 = msoFileDialogFolderPicker
.title = title
.AllowMultiSelect = False

Select Case Filter
Case 1
.Filters.Clear
Case 2
.Filters.Add "Access", "*.bmp; *.jpg; *.png; *.accde", 1
Case 3
.Filters.Add "Excel", "*.xls", 1
Case 4
.Filters.Add "Text", "*.txt", 1
Case 5
.Filters.Add "CSV", "*.csv", 1
End Select

If .Show = -1 Then
SelectFile = fso.GetFile(Application.FileDialog(4).SelectedItems(1)) '4 = msoFileDialogFolderPicker
Else
GoTo finalize
End If
End With

finalize:
Set fso = Nothing

End Function


Any help would be appreciated

 

[Yatiman Idara]

Another sample that could possibly be tampered with to achieve the above object is below:

Public Function GetFileFolder(strType As String, strTitle As String) As String
Dim fDialog As office.FileDialog
Dim varFile As Variant
Dim typeOfPicker As Integer

Select Case strType
Case "folder"
typeOfPicker = msoFileDialogFolderPicker
Case "file"
typeOfPicker = msoFileDialogFilePicker
End Select

'Get the folder to start in
Set fDialog = Application.FileDialog(typeOfPicker)
With fDialog
.title = strTitle
.AllowMultiSelect = False
.InitialFileName = "D:\New Program\Program"
'change above to network path

If .Show = True Then
If .SelectedItems.count = 0 Then
'user clicked open but didn't select a file
GetFileFolder = 0
End If

For Each varFile In .SelectedItems
GetFileFolder = varFile
Next
Else
GetFileFolder = ""
End If
End With
End Function

 

[Yatiman Idara]

Ok so I have managed to get there (well I am close)

I used following code to save the imagepath in txtImagePath which is linked to the imagepath field in my table.

Private Sub ImageFrame_DblClick(Cancel As Integer)
On Error GoTo SubError
'Add MS Office 14.0 Object Library in references
Dim fDialog As Office.FileDialog
Dim varFile As Variant

txtSelectedPath = ""

'set up the file dialog
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

With fDialog
.Title = "Choose the image you would like to display"
.AllowMultiSelect = False
'change this to network path
.InitialFileName = "D:\New Program\Program\Photos\"

.Filters.Clear
.Filters.Add "Bmp files", "*.bmp*"
.Filters.Add "Jpeg files", "*.jpg*"
.Filters.Add "Png files", "*.png*"

If .Show = True Then
If .SelectedItems.count = 0 Then
'user clicked open but didn't select a file
GoTo SubExit
End If

'varfile = .selecteditems(1)
'txtSelectedPath = varFile

For Each varFile In .SelectedItems
txtSelectedPath = txtSelectedPath & varFile & vbCrLf
Next
Else
'user cancelled dialog without choosing
'do you need to react?
End If
End With

SubExit:
On Error Resume Next
Set fDialog = Nothing
Exit Sub

SubError:
MsgBox "Error Number: " & Err.Number & " = " & Err.Description, vbCritical + vbOKOnly, _
"An error occurred"
GoTo SubExit

End Sub


Only problem is that even though the code updates the path in my table, it removes the old image from the ImageFrame and yet doesn't show the new image based on the image path.

Any suggestions?

Or am i just talking to myself?

 

[arnelgp]

after updating the path, you must Requery your image control:

[ImageControl].Requery

 

[Yatiman Idara]

Hi

sorry for not providing an update as I didn't think anyone was following this thread.

I managed to get it to work by removing the loop and uncommenting the following:

'varfile = .selecteditems(1)
'txtSelectedPath = varFile

Rest of the code remained the same.

For some reason it provides instant updates without requiring a requery.

Very strange but it works so yay

So just to recap:

1) I store image paths in 'ImagePath' shorttext field.
2) I place an 'image' control and make the ImagePath as its source. I name this control ImageFrame
3) I place a textbox in my form sourced to the image path and named txtSelectedPath
4) In the double click event of this image control I place the following code:

Private Sub ImageFrame_DblClick(Cancel As Integer)
On Error GoTo SubError
'Add MS Office 14.0 Object Library in references
Dim fDialog As Office.FileDialog
Dim varFile As Variant

txtSelectedPath = ""

'set up the file dialog
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

With fDialog
.Title = "Choose the image you would like to display"
.AllowMultiSelect = False
'change this to network path
.InitialFileName = "D:\New Program\Program\Photos\"

.Filters.Clear
.Filters.Add "Image files", "*.bmp; *.jpg; *.png"
'.Filters.Add "BMP files", "*.bmp*"
'.Filters.Add "JPG files", "*.jpg*"
'.Filters.Add "PNG files", "*.png*"

If .Show = True Then
If .SelectedItems.count = 0 Then
'user clicked open but didn't select a file
GoTo SubExit
End If

varFile = .SelectedItems(1)
txtSelectedPath = varFile

' For Each varFile In .SelectedItems
' txtSelectedPath = txtSelectedPath & varFile & vbCrLf
' Next
Else
'user cancelled dialog without choosing
'do you need to react?
End If
End With

SubExit:
On Error Resume Next
Set fDialog = Nothing
Exit Sub

SubError:
MsgBox "Error Number: " & Err.Number & " = " & Err.Description, vbCritical + vbOKOnly, _
"An error occurred"
GoTo SubExit
End Sub


And VOILA my first image management system