Can the below code be modified for select. Drive Letter, Dir.

[BrianPaul]

Option Compare Database
Option Explicit

Public Function ListFiles(strPath As String, Optional strFileSpec As String,
Optional bIncludeSubfolders As Boolean, Optional lst As Object)
On Error GoTo Err_Handler
'Purpose: List the files in the path.
'Arguments: strPath = the path to search.
' strFileSpec = "*.*" unless you specify differently.
' bIncludeSubfolders: If True, returns results from
subdirectories of strPath as well.
' lst: if you pass in a list box, items are added to it. If
'not, files are listed to immediate window.
' The list box must have its Row Source Type property set
'to Value List.
'Method: FilDir() adds items to a collection, calling itself
'recursively for subfolders.
Dim colDirList As New Collection
Dim varItem As Variant

Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)

'Add the files to a list box if one was passed in. Otherwise list to the
'Immediate Window.
If lst Is Nothing Then
For Each varItem In colDirList
Debug.Print varItem
Next
Else
If TypeOf lst Is DAO.Recordset Then
For Each varItem In colDirList
lst.AddNew
lst.Fields(0) = varItem
lst.Update
Next
ElseIf TypeOf lst Is Collection Then
For Each varItem In colDirList
lst.Add varItem
Next
ElseIf TypeOf lst Is ListBox Then
For Each varItem In colDirList
lst.AddItem varItem
Next
End If
End If

Exit_Handler:
Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Function

Private Function FillDir(colDirList As Collection, ByVal strFolder As
String, strFileSpec As String, _
bIncludeSubfolders As Boolean)
'Build up a list of files, and then add add to this list, any additional
folders
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

'Add the files to the folder.
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
colDirList.Add strFolder & strTemp
strTemp = Dir
Loop

If bIncludeSubfolders Then
'Build collection of additional subfolders.
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop
'Call function recursively for each subfolder.
For Each vFolderName In colFolders
Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName),
strFileSpec, True)
Next vFolderName
End If
End Function

Public Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function

'****************************************************

'You can then call the code like this
'****************************************************
Function testRs()
Dim strPath As String
Dim strFileSpec As String
Dim bIncludeSubfolders As Boolean

Dim d As DAO.Database
Dim c As DAO.Recordset
Dim i As Integer


'*****************SPECIFY THE PATH YOU WANT*************
strPath = "Q:\"
strFileSpec = "*.*"
bIncludeSubfolders = True

Set d = CurrentDb

' Uncomment the following line if you want to empty the target table before
'filling it again
' d.Execute "DELETE * FROM [TItem]"
Set c = d.OpenRecordset("SELECT [MP3] FROM [TMP3]", dbOpenDynaset)
'Set c = d.OpenRecordset("SELECT [MP3] FROM [TMP3Back]", dbOpenDynaset)

Call ListFiles(strPath, strFileSpec, bIncludeSubfolders, c)

c.Close
Set c = Nothing
Set d = Nothing


End Function

'****************************************************


I want to modify this:
strPath = "Q:\"
strFileSpec = "*.*"

Where right now You have to specify the Q Drive.

I would like the end user of the database select the Drive Letter and
directory of the files so It would import them in.

I have a button on the main form that deletes the table and repopulates it
based on this code:


DoCmd.Close

DBEngine(0)(0).Execute "DELETE FROM TMP3;", dbFailOnError
DBEngine(0)(0).Execute "DELETE FROM TMP3Back;", dbFailOnError
Call testRs
Call testRsBack

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "MainMenu"
DoCmd.OpenForm stDocName, , , stLinkCriteria

DoCmd.Maximize


End Sub

Private Sub Form_Load()
'Written by Helen Feddema 11-2-2000
'Last modified 11-2-2000

On Error GoTo ErrorHandler

Dim strSQL As String

'DoCmd.RunCommand acCmdSizeToFitForm
DoCmd.SetWarnings False
'Clear tables of available and selected items
strSQL = "DELETE * FROM TMP3Selected"
DoCmd.RunSQL strSQL
strSQL = "DELETE * FROM TMP3BACK"
DoCmd.RunSQL strSQL
'Fill table of available items from table of categories
strSQL = "INSERT INTO TMP3Back (MP3) " _
& "SELECT MP3 FROM TMP3;"
DoCmd.RunSQL strSQL
Me![List27].Requery
'Me![ResultMP3].Requery

ErrorHandlerExit:
Exit Sub

ErrorHandler:
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit

End Sub

 

[Piet Linden]

Goal:
Open the OpenSaveFile dialog to a specific location...

Here's what Terry Kreft says in his article, "API: BrowseFolder
Dialog", here:
http://www.mvps.org/access/api/api0002.htm

Stephen Lebans has added functionality to open the browse folder at a
specific place.
http://www.lebans.com/callbackbrowser.htm

so toss the code you got from Helen Feddema... use Stephen's instead.
All of his code is obscenely well documented. You can even download a
working example to modify. Maybe import his stuff into your database,
modify and get it working, then put in your real form...

 

[BrianPaul]

Thanks Piet, Where Do I put the code at and take the other out at.

Thanks