Combo box to Look up Directory & File for Image 2

[SockMonkey]

I have created a form that will take the file path information and display a photo in an image frame without storing it in Access, thus saving space. Right now you have to manually enter in the file path and file name information into fields.

Fields:
FilePath Text 255
FileName Text 50
FileDescription Memo
PictureFrame Unbound Image Control

The Problem: I don't know how to create a combo box up to a certain level of directories on our network for the file path (ie. L:\Property\MainSt(12)\Photos) and to paste this information into the FilePath field.
I need the second combo then to lookup files in this FilePath that are only of the extension *.jpg, *.bmp, and *.gif and to place the selected file into the FileName field.

Once this is succesful the image box will display the corresponding property photo.

Thanks in advance for any help & expertise.

 

[seaport]

You can try the filesearch object. Here is an example copied from Access 2000 Help.

With Application.FileSearch
.NewSearch
.LookIn = "C:\My Documents"
.SearchSubFolders = True
.FileName = "Run"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
End With


Seaport

 

[SockMonkey]

I am using Access 97 and dont believe this method is supported.

 

[billieclap]

Hi,
I have the same problem, Iam watching to to if someone can answer this riddle, best of luck
Bill

 

[MontyBurns]

Hi

I've just got a similar method to work: the basic idea is that you dbl click the text box containing the path and it calls the Function GetOpenFile (contained in the module code below) which launches a little file browser and returns the full path to the selected file (inc. the file name and ext).

In the form, add a text-box, and this code:

'-------------------------------------------------
Private Sub DocumentUNC_DblClick(Cancel As Integer)
Dim strPath As String

strPath = GetOpenFile
Me.DocumentUNC = strPath
End If

End Sub
'----------------------------------------------------

The function 'GetOpenFile' is contained in this code module (called BrowseForFile in my case, but not important). It's a bit long, but just copy it into a new module:

'----------------------------------------------------
Option Compare Database
Option Explicit

Public Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Public Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Type tagOPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type



Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Function TestIt()
Dim strFilter As String
Dim lngFlags As Long
strFilter = ahtAddFilterItem(strFilter, "Databases (*.*)", "*.*&quot

MsgBox "You selected: " & ahtCommonFileOpenSave(InitialDir:="A:\", _
Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
DialogTitle:="Select backup file to restore from&quot
' Since you passed in a variable for lngFlags,
' the function places the output flags value in the variable.

Debug.Print Hex(lngFlags)
End Function

Function GetOpenFile(Optional varDirectory As Variant, Optional varTitleForDialog As Variant) As String
' This gets the file name
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName, strRestoreFrom As Variant
' Specify that the chosen file must already exist,
' don't change directories when you're done
lngFlags = ahtOFN_FILEMUSTEXIST Or ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
If IsMissing(varDirectory) Then
varDirectory = ""
End If
If IsMissing(varTitleForDialog) Then
varTitleForDialog = ""
End If

' Define the filter string and allocate space in the "c"
strFilter = ahtAddFilterItem(strFilter, "All Files", "*.*&quot
' Now actually call to get the file name.
varFileName = ahtCommonFileOpenSave( _
OpenFile:=True, _
InitialDir:=varDirectory, _
Filter:=strFilter, _
Flags:=lngFlags, _
DialogTitle:=varTitleForDialog)
If Not IsNull(varFileName) Then
varFileName = TrimNull(varFileName)
End If
If varFileName <> &quot;&quot; Then
strRestoreFrom = varFileName
GetOpenFile = varFileName
Else:
GetOpenFile = &quot;Incorrect&quot;
End If
End Function

Function ahtCommonFileOpenSave( _
Optional ByRef Flags As Variant, _
Optional ByVal InitialDir As Variant, _
Optional ByVal Filter As Variant, _
Optional ByVal FilterIndex As Variant, _
Optional ByVal DefaultExt As Variant, _
Optional ByVal FileName As Variant, _
Optional ByVal DialogTitle As Variant, _
Optional ByVal hwnd As Variant, _
Optional ByVal OpenFile As Variant) As Variant

Dim OFN As tagOPENFILENAME
Dim strFileTitle As String
Dim fResult As Boolean
Dim strFileName As Variant
' Give the dialog a caption title.
If InitialDir = &quot;&quot; Then InitialDir = &quot;\\myserver\myshare\mypath\&quot;
If IsMissing(Filter) Then Filter = &quot;&quot;
If IsMissing(FilterIndex) Then FilterIndex = 1
If IsMissing(Flags) Then Flags = 0&
If IsMissing(DefaultExt) Then DefaultExt = &quot;&quot;
If IsMissing(FileName) Then FileName = &quot;&quot;
If IsMissing(DialogTitle) Then DialogTitle = &quot;&quot;
If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
If IsMissing(OpenFile) Then OpenFile = True
' Allocate string space for the returned strings.
strFileName = Left(FileName & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With OFN
.lStructSize = Len(OFN)
.hwndOwner = hwnd
.strFilter = Filter
.nFilterIndex = FilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = DialogTitle
.Flags = Flags
.strDefExt = DefaultExt
.strInitialDir = InitialDir
.hInstance = 0
.lpfnHook = 0
'New for NT 4.0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
End With
' This will pass the desired data structure to the
' Windows API, which will in turn uses it to display
' the Open/Save As Dialog.
If OpenFile Then
fResult = aht_apiGetOpenFileName(OFN)
Else
fResult = aht_apiGetSaveFileName(OFN)
End If

If fResult Then
If Not IsMissing(Flags) Then Flags = OFN.Flags
ahtCommonFileOpenSave = TrimNull(OFN.strFile)
Else
ahtCommonFileOpenSave = vbNullString
End If
End Function

Function ahtAddFilterItem(strFilter As String, _
strDescription As String, Optional varItem As Variant) As String
If IsMissing(varItem) Then varItem = &quot;*.*&quot;
ahtAddFilterItem = strFilter & _
strDescription & vbNullChar & _
varItem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
intPos = InStr(strItem, vbNullChar)
If intPos > 0 Then
TrimNull = Left(strItem, intPos - 1)
Else
TrimNull = strItem
End If
End Function
'----------------------------------------------------

There are lines/subs/functions which take the filter criteria and starting dir - you'll need to amend these. You can also call GetOpenFile with a starting dir etc.

ps - search for \\myserver\myshare\mypath\ and change this UNC starting path to whatever applies to your app.

Hope this helps a few of you,
Burns

 

[billieclap]

Hi MontyBurns,
I am overwhelmed by the code!
I will try to put it in the right place and report back
THANK YOU in advance
Bill

 

[JoaoTL]

Hi

1. with this function you can get the file List to your combo.

2. Create a OLE Field in a Table and store your Images, insert a OLE field in the Form and you can use the Dlookup() function like this in the default value *= DLookup(&quot;[ImageFile]&quot;, &quot;Table&quot;,&quot;[ImageFile] = YourComboValue&quot*

Hope it helps



Function GetFileList(strDirPath As String, _
Optional strFileSpec As String = &quot;*.*&quot;, _
Optional strDelim As String = &quot;,&quot As String

' This procedure returns a delimited list of files from the
' strDirPath directory that match the strFileSpec argument.
' The default delimiter character is a comma. By default, the
' procedure returns all files (&quot;*.*&quot from the designated
' directory.

Dim strFileList As String ' Used to collect the file list.
Dim strFileNames As String ' The full path and criteria to search for.
Dim strTemp As String ' Temporarily holds the matching file name.

' Make sure that strDirPath ends in a &quot;\&quot; character.
If Right$(strDirPath, 1) <> &quot;\&quot; Then
strDirPath = strDirPath & &quot;\&quot;
End If

' This will be our file search criteria.
strFileNames = strDirPath & strFileSpec

' Create a list of matching files delimited by the
' strDelim character.
strTemp = Dir$(strFileNames)
Do While Len(strTemp) <> 0
strFileList = strFileList & strTemp & strDelim
strTemp = Dir$()
Loop

If Len(strFileList) > 1 Then
' If there are matching files, remove the delimiter
' character from the end of the list.
GetFileList = Left(strFileList, Len(strFileList) - 1)
Else
GetFileList = &quot;&quot;
End If

Best Regards

---
JoaoTL
NOSPAM_mail@jtl.co.pt

http://www.jtl.co.pt

http://www.jtl.co.pt/Access