Hi Merdok
I did something similar with a database I created last year.
I had a search form - FrmDirectories
On the form was a list box, which stored all of the image files within the directory chosen by the user - lstFiles
A textbox that stored the path - TxtPath
An Image box that displayed a picture of the image - Image1
Three cmd buttons
CmdBrowse - Opened the Common Dialog Box
CmdGetFiles - This searched for all of the image files within the directory specified from the Common Dialog Box.
CmdAdd - This opened another form (FrmAddPhoto) and added the image to the database.
I also had a table that was used to store the files that found in the specified directory - TblDirectories. This was made up of an Autonumber field and a Filepath text field (length 75 characters)
Now for the code.
Behind the search form (FrmDirectories) I had the following code
Option Compare Database
Private Sub CmdAdd_Click()
DoCmd.OpenForm "frmAddPhoto", acNormal, , , acFormAdd, acWindowNormal, Me!lstFiles
End Sub
Private Sub cmdBrowse_Click()
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BROWSEINFO
szTitle = "Search in:-"
With tBrowseInfo
.hWndOwner = Me.hwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
txtPath = sBuffer
txtPath.SetFocus
cmdGetFiles.Enabled = True
End If
End Sub
Private Sub cmdGetFiles_Click()
Dim X As Integer
Dim strSQL As String
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tblDirectories"
DoCmd.SetWarnings True
lstFiles.Requery
X = FindAllFiles(txtPath)
lstFiles.Requery
End Sub
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Err_Form_Open
Dim strSQL As String
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tblDirectories"
DoCmd.SetWarnings True
lstFiles.Requery
CmdAdd.Enabled = False
cmdGetFiles.Enabled = False
Exit_Form_Open:
Exit Sub
Err_Form_Open:
MsgBox Err.Description
Resume Exit_Form_Open
End Sub
Private Sub lstFiles_Click()
Me!Image1.Picture = Me!lstFiles
CmdAdd.Enabled = True
cmdGetFiles.Enabled = False
End Sub
I then had 2 modules. The first basBrowse had the following code
Option Compare Database
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const MAX_PATH = 260
Declare Function SHBrowseForFolder Lib _
"shell32" (lpBI As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList _
As Long, ByVal lpBuffer As String) As Long
Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, ByVal _
lpString2 As String) As Long
Public Type BROWSEINFO
hWndOwner As Long
pidlRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
The second module basSearchFiles had the code
Option Compare Database
Option Explicit
Function FindAllFiles(Path As String)
On Error GoTo err_FindAllFiles
Dim intCounter As Integer
Dim strFiles As String
Dim strFileName As String
intCounter = 0
With Application.FileSearch
.LookIn = Path
.SearchSubFolders = True
.filename = "*.jpg; *.bmp; *.gif; *.pcd; *.png; *.php; *.pza; *.ufx; *.tif"
.Execute
If .Execute() > 0 Then
Dim db As Database
Dim rstFilesFound As Recordset
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found.", vbOKOnly, "PhotoView"
Set db = CurrentDb()
Set rstFilesFound = db.OpenRecordset("tblDirectories")
For intCounter = 1 To .FoundFiles.Count
strFileName = .FoundFiles(intCounter)
rstFilesFound.AddNew
rstFilesFound("FilePath") = strFileName
rstFilesFound.Update
Next intCounter
Else
MsgBox "There were no files found."
End If
End With
rstFilesFound.Close
db.Close
Set rstFilesFound = Nothing
Set db = Nothing
exit_FindAllFiles:
Exit Function
err_FindAllFiles:
MsgBox Err.Description
Resume exit_FindAllFiles
End Function
If you don't want a browse button, just place the cmdBrowse_Click() code under the ImageBoxName_DoubleClick() event.
HTH
Dave
