Use File/Folder selector to specify default location path

I have an application that allows an end user to store a file path and associate the external file (i.e. .pdf, .docx, etc) with a specific entry in my Access 2010 database.  For example, they may have listed a specific purchase in my database and have a receipt.  They scan the receipt and use my interface to select the scan file.  My database then makes a copy of this file and saves it in a pre-determined location and stores the path in a data table.  In the future, if the user looks up this entry, they can select a button which opens the scanned file so they can view the actual receipt.  This all works great.  Here's my problem...

Each user may want to store their scans in a different location, either on their local hard drive, or a network location.  I would like to give them the ability to select a "default location" for storage of scanned images.  I have a small form set up that has two text boxes.  First one shows the current default location.  Second one is where they can enter a new default location.  I have a button on the form called "Choose" for "Choose Location...", and I have the following code associated with that button:

Private Sub Choose_Click()

    ' Displays the Office File Open dialog to choose a file name
    ' for PIC1.  If the user selects a file
    ' display it in the image control.
    Dim sMyDocs As String
    Dim strStartDir As String
    Dim strFilter As String
    Dim lngFlags As Long
    Dim sFile As String
    sFile = ""
    'Start the file browser from the desired directory
    Set oShell = CreateObject("WScript.Shell")
    sMyDocs = oShell.SpecialFolders("MyDocuments")
    strStartDir = sMyDocs
    strStartDir = Left(strStartDir, Len(strStartDir))
    strFilter = ahtAddFilterItem(strFilter, "Word", "*.doc")
    strFilter = ahtAddFilterItem(strFilter, "PDFs", "*.pdf")
    strFilter = ahtAddFilterItem(strFilter, "Excel", "*.xls")
    strFilter = ahtAddFilterItem(strFilter, "All Files", "*.*")
    sFile = ahtCommonFileOpenSave(InitialDir:=strStartDir, OpenFile:=False, Filter:=strFilter, FilterIndex:=4, Flags:=lngFlags, DialogTitle:="Select Folder")
                Me.Form1.Text = sFile
                If (IsNull(Me.Form1) = True) Then
                    Exit Sub
                End If
End Sub

Open in new window

Problem is, the selector won't let them stop at a folder.  It is waiting for them to select a specific file.  

Is there any way I can use the file selector, or something like it, that will accept entry of only a path, without a specific file at the end of it?
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

In the click event of my "find" button:

Me.txtPath = fChooseDirectory()

The code:

Public Function fChooseDirectory()

    'Declare a variable as a FileDialog object.
    'Dim fd As FileDialog

   '''' Const msoFileDialogFolderPicker = 4 'use for late binding
    Dim fd As Object
    'Create a FileDialog object as a File Picker dialog box.
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)

    'Declare a variable to contain the path
    'of each selected item. Even though the path is a String,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim vrtSelectedItem As Variant

    'Use a With...End With block to reference the FileDialog object.
    With fd

        'Use the Show method to display the File Picker dialog box and return the user's action.
        'The user pressed the action button.
        If .Show = -1 Then

            'Step through each string in the FileDialogSelectedItems collection.
            For Each vrtSelectedItem In .SelectedItems

                'vrtSelectedItem is a String that contains the path of each selected item.
                'You can use any file I/O functions that you want to work with this path.
                'This example simply displays the path in a message box.

                'Only one item will be returned since the file dialog is a folder picker
                'MsgBox "The path is: " & vrtSelectedItem
                fChooseDirectory = vrtSelectedItem
                Exit Function
            Next vrtSelectedItem
        'The user pressed Cancel.
        End If
    End With

    'Set the object variable to Nothing.
    Set fd = Nothing
    fChooseDirectory = "Error - nothing chosen"
End Function

Open in new window

JohnMc0620Author Commented:
Hi Pat,

I created a module and copied this code in to it, then used to the line above for my button.  Got the following error:

on this line of the function:

    Set fd = Application.FileDialog(msoFileDialogFolderPicker)

Open in new window

My bad.  I forgot to mention that you need to set a reference to the Microsoft Office xx Object Library.  XX if you are using A2010 is 14.0.  If you are using a different version of Access, the number will be different.  A2007 is 12.0.  Apparently MS is superstitious and elected not to use 13.0 as a version number.

Open any code module in design view.  Go to Tools/References and scroll until you find the correct library for your version of Access.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
JohnMc0620Author Commented:
That's it!  Thanks Pat!  It works perfectly!

Also, if anyone is looking for another way to accomplish the same thing, I found this while surfing for the solution just before Pat posted his.  I like Pat's better because it gives the same file selector that people are used to.  But, this other method by Stephen Lebans is just as functional.  Thank you!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.