[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1124
  • Last Modified:

VBA code for "Browse" button that returns path and file name to control

Hello ~

Can anyone provide VBA code for a "Browse" button that opens a Windows dialogue box, allows browsing to a file and returns the path and file name to a control?  ...Or direct me to such code that I can use freely?

Many Thanks ~ Jacob
0
Chi Is Current
Asked:
Chi Is Current
  • 5
  • 5
  • 5
  • +4
1 Solution
 
harfangCommented:
There is one in Northwind.mdb, the example database that came with your Access version. This you can use feely, everyone does ;)

cheers!
0
 
harfangCommented:
Oh, the link above is not debugged. True, the very own version of Northwind isn't either... If you go that way, consider the following patch for the "Const" section:

' This is taken from the official API constants, with a bug removed (yaboms!).
' You see, &H8000 is &B1000000000000000, or &B11111111111111111000000000000000
' when converted to long, got it? What we want is, of course, &H8000&, which is
' a positive number.
Const OFN_DEFAULT = &HA0804         ' (Explorer, HideReadOnly, etc.)
Const OFN_OVERWRITEPROMPT = &H2&
Const OFN_FILEMUSTEXIST = &H1000&
Const OFN_NOREADONLYRETURN = &H8000&

Bottom line: long constants NEED the '&' data type qualifyer...

I bet this a known issue :)
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
Chi Is CurrentAuthor Commented:
Thank you both for your quick replies!

harfang ~  I have looked through the Northwind forms and I do not see a browse button.  'Am using Access 2000.  Can you tell me which form contains the example?

Sash ~ 'Looks interesting.  'Will check this out tomorrow.
0
 
bluelizardCommented:
adding another link (risking that the code is the same as in the previous answers...):

http://www.mvps.org/access/api/api0002.htm


--bluelizard
0
 
harfangCommented:
My fault...
It was in Access97, another sample database called ORDERS.mdb, example of a front-end application using Northwind as data file. Naturally, it has code to relink all tables and thus contained code to use Window API browse feature.
Let me post the full module here, the link above contains uncomplete code:

Note that the following constant is broken:
Const OFN_NOREADONLYRETURN = &H8000    ' should be %H8000&

module "RefreshTableLinks" from the Access97 ORDERS.MDB sample database

-------------------------------------------------------------------------------------------------
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                   RefreshTableLinks                          '
'                                                              '
'      This module contains functions that refresh the         '
'      links to Northwind tables if they aren't available.     '
'                                                              '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit           ' Require variables to be declared before being used.
Option Compare Database   ' Use database order for string comparisons.

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Type MSA_OPENFILENAME
    ' Filter string used for the File Open dialog filters.
    ' Use MSA_CreateFilterString() to create this.
    ' Default = All Files, *.*
    strFilter As String
    ' Initial Filter to display.
    ' Default = 1.
    lngFilterIndex As Long
    ' Initial directory for the dialog to open in.
    ' Default = Current working directory.
    strInitialDir As String
    ' Initial file name to populate the dialog with.
    ' Default = "".
    strInitialFile As String
    strDialogTitle As String
    ' Default extension to append to file if user didn't specify one.
    ' Default = System Values (Open File, Save File).
    strDefaultExtension As String
    ' Flags (see constant list) to be used.
    ' Default = no flags.
    lngFlags As Long
    ' Full path of file picked.  On OpenFile, if the user picks a
    ' nonexistent file, only the text in the "File Name" box is returned.
    strFullPathReturned As String
    ' File name of file picked.
    strFileNameReturned As String
    ' Offset in full path (strFullPathReturned) where the file name
    ' (strFileNameReturned) begins.
    intFileOffset As Integer
    ' Offset in full path (strFullPathReturned) where the file extension begins.
    intFileExtension As Integer
End Type

Const ALLFILES = "All Files"

Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As Long
    nMaxCustrFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustrData As Long
    lpfnHook As Long
    lpTemplateName As Long
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Function FindNorthwind(strSearchPath) As String
' Displays the open file dialog box for the user to locate
' the Northwind database. Returns the full path to Northwind.
   
    Dim msaof As MSA_OPENFILENAME
   
    ' Set options for the dialog box.
    msaof.strDialogTitle = "Where Is Northwind?"
    msaof.strInitialDir = strSearchPath
    msaof.strFilter = MSA_CreateFilterString("Databases", "*.mdb")
   
    ' Call the Open File dialog routine.
    MSA_GetOpenFileName msaof
   
    ' Return the path and file name.
    FindNorthwind = Trim(msaof.strFullPathReturned)
   
End Function


Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
' Creates a filter string from the passed in arguments.
' Returns "" if no args are passed in.
' Expects an even number of args (filter name, extension), but
' if an odd number is passed in, it appends *.*
   
    Dim strFilter As String
    Dim intRet As Integer
    Dim intNum As Integer

    intNum = UBound(varFilt)
    If (intNum <> -1) Then
        For intRet = 0 To intNum
            strFilter = strFilter & varFilt(intRet) & vbNullChar
        Next
        If intNum Mod 2 = 0 Then
            strFilter = strFilter & "*.*" & vbNullChar
        End If
       
        strFilter = strFilter & vbNullChar
    Else
        strFilter = ""
    End If

    MSA_CreateFilterString = strFilter
End Function

Function MSA_ConvertFilterString(strFilterIn As String) As String
' Creates a filter string from a bar ("|") separated string.
' The string should pairs of filter|extension strings, i.e. "Access Databases|*.mdb|All Files|*.*"
' If no extensions exists for the last filter pair, *.* is added.
' This code will ignore any empty strings, i.e. "||" pairs.
' Returns "" if the strings passed in is empty.
   
    Dim strFilter As String
    Dim intNum As Integer, intPos As Integer, intLastPos As Integer

    strFilter = ""
    intNum = 0
    intPos = 1
    intLastPos = 1

    ' Add strings as long as we find bars.
    ' Ignore any empty strings (not allowed).
    Do
        intPos = InStr(intLastPos, strFilterIn, "|")
        If (intPos > intLastPos) Then
            strFilter = strFilter & Mid$(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
            intNum = intNum + 1
            intLastPos = intPos + 1
        ElseIf (intPos = intLastPos) Then
            intLastPos = intPos + 1
        End If
    Loop Until (intPos = 0)
       
    ' Get last string if it exists (assuming strFilterIn was not bar terminated).
    intPos = Len(strFilterIn)
    If (intPos >= intLastPos) Then
        strFilter = strFilter & Mid$(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
        intNum = intNum + 1
    End If
   
    ' Add *.* if there's no extension for the last string.
    If intNum Mod 2 = 1 Then
        strFilter = strFilter & "*.*" & vbNullChar
    End If
   
    ' Add terminating NULL if we have any filter.
    If strFilter <> "" Then
        strFilter = strFilter & vbNullChar
    End If
   
    MSA_ConvertFilterString = strFilter
End Function

Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
' Opens the file save dialog.
   
    Dim of As OPENFILENAME
    Dim intRet As Integer

    MSAOF_to_OF msaof, of
    of.flags = of.flags Or OFN_HIDEREADONLY
    intRet = GetSaveFileName(of)
    If intRet Then
        OF_to_MSAOF of, msaof
    End If
    MSA_GetSaveFileName = intRet
End Function

Function MSA_SimpleGetSaveFileName() As String
' Opens the file save dialog with default values.
    Dim msaof As MSA_OPENFILENAME
    Dim intRet As Integer
    Dim strRet As String
   
    intRet = MSA_GetSaveFileName(msaof)
    If intRet Then
        strRet = msaof.strFullPathReturned
    End If
   
    MSA_SimpleGetSaveFileName = strRet
End Function

Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer
' Opens the file open dialog.
   
    Dim of As OPENFILENAME
    Dim intRet As Integer

    MSAOF_to_OF msaof, of
    intRet = GetOpenFileName(of)
    If intRet Then
        OF_to_MSAOF of, msaof
    End If
    MSA_GetOpenFileName = intRet
End Function

Function MSA_SimpleGetOpenFileName() As String
' Opens the file open dialog with default values.

    Dim msaof As MSA_OPENFILENAME
    Dim intRet As Integer
    Dim strRet As String
   
    intRet = MSA_GetOpenFileName(msaof)
    If intRet Then
        strRet = msaof.strFullPathReturned
    End If
   
    MSA_SimpleGetOpenFileName = strRet
End Function

Public Function CheckLinks() As Boolean
' Check links to the Northwind database; returns true if links are OK.
   
    Dim dbs As Database, rst As Recordset
   
    Set dbs = CurrentDb

    ' Open linked table to see if connection information is correct.
    On Error Resume Next
    Set rst = dbs.OpenRecordset("Products")

    ' If there's no error, return True.
    If Err = 0 Then
        CheckLinks = True
    Else
        CheckLinks = False
    End If
   
End Function

Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
' This sub converts from the win32 structure to the friendly MSAccess structure.
   
    msaof.strFullPathReturned = Left$(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
    msaof.strFileNameReturned = of.lpstrFileTitle
    msaof.intFileOffset = of.nFileOffset
    msaof.intFileExtension = of.nFileExtension
End Sub


Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
' This sub converts from the friendly MSAccess structure to the win32 structure.
   
    Dim strFile As String * 512

    ' Initialize some parts of the structure.
    of.hwndOwner = Application.hWndAccessApp
    of.hInstance = 0
    of.lpstrCustomFilter = 0
    of.nMaxCustrFilter = 0
    of.lpfnHook = 0
    of.lpTemplateName = 0
    of.lCustrData = 0
   
    If msaof.strFilter = "" Then
        of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
    Else
        of.lpstrFilter = msaof.strFilter
    End If
    of.nFilterIndex = msaof.lngFilterIndex
   
    of.lpstrFile = msaof.strInitialFile & String$(512 - Len(msaof.strInitialFile), 0)
    of.nMaxFile = 511

    of.lpstrFileTitle = String$(512, 0)
    of.nMaxFileTitle = 511

    of.lpstrTitle = msaof.strDialogTitle

    of.lpstrInitialDir = msaof.strInitialDir
   
    of.lpstrDefExt = msaof.strDefaultExtension

    of.flags = msaof.lngFlags
   
    of.lStructSize = Len(of)
End Sub

Private Function RefreshLinks(strFileName As String) As Boolean
' Refresh links to the supplied database. Return True if successful.

    Dim dbs As Database
    Dim intCount As Integer
    Dim tdf As TableDef

    ' Loop through all tables in the database.
    Set dbs = CurrentDb
    For intCount = 0 To dbs.TableDefs.Count - 1
        Set tdf = dbs.TableDefs(intCount)

        ' If the table has a connect string, it's a linked table.
        If Len(tdf.Connect) > 0 Then
            tdf.Connect = ";DATABASE=" & strFileName
            Err = 0
            On Error Resume Next
            tdf.RefreshLink         ' Relink the table.
            If Err <> 0 Then
                RefreshLinks = False
                Exit Function
            End If
        End If
    Next intCount

    RefreshLinks = True        ' Relinking complete.
   
End Function

Public Function RelinkTables() As Boolean
' Tries to refresh the links to the Northwind database.
' Returns True if successful.

    Const conMaxTables = 8
    Const conNonExistentTable = 3011
    Const conNotNorthwind = 3078
    Const conNwindNotFound = 3024
    Const conAccessDenied = 3051
    Const conReadOnlyDatabase = 3027
    Const conAppTitle = "Orders"

    Dim strAccDir As String
    Dim strSearchPath As String
    Dim strFileName As String
    Dim intError As Integer
    Dim strError As String

    ' Get name of directory where Msaccess.exe is located.
    strAccDir = SysCmd(acSysCmdAccessDir)

    ' Get the default sample database path.
    If Dir(strAccDir & "Samples\.") = "" Then
        strSearchPath = strAccDir
    Else
        strSearchPath = strAccDir & "Samples\"
    End If

    ' Look for the Northwind database.
    If (Dir(strSearchPath & "Northwind.mdb") <> "") Then
        strFileName = strSearchPath & "Northwind.mdb"
    Else
        ' Can't find Northwind, so display the File Open dialog.
        MsgBox "Can't find linked tables in the Northwind database. You must locate Northwind in order to use " _
            & conAppTitle & ".", vbExclamation
        strFileName = FindNorthwind(strSearchPath)
        If strFileName = "" Then
            strError = "Sorry, you must locate Northwind to open " & conAppTitle & "."
            GoTo Exit_Failed
        End If
    End If

    ' Fix the links.
    If RefreshLinks(strFileName) Then   ' It worked!
        RelinkTables = True
        Exit Function
    End If
   
    ' If it failed, display an error.
    Select Case Err
    Case conNonExistentTable, conNotNorthwind
        strError = "File '" & strFileName & "' does not contain the required Northwind tables."
    Case Err = conNwindNotFound
        strError = "You can't run " & conAppTitle & " until you locate the Northwind database."
    Case Err = conAccessDenied
        strError = "Couldn't open " & strFileName & " because it is read-only or located on a read-only share."
    Case Err = conReadOnlyDatabase
        strError = "Can't reattach tables because " & conAppTitle & " is read-only or is located on a read-only share."
    Case Else
        strError = Err.Description
    End Select
   
Exit_Failed:
    MsgBox strError, vbCritical
    RelinkTables = False
   
End Function

0
 
will_scarlet7Commented:
Hi All,
    I expect that Jacob (the Author) may have called it quits until tomorrow, but I thought to add an opinion. I don't mean to be saying that you are wrong as I may not know all the history or what has gone before, but wouldn't it be simpler to just use the "Office ## Object Library" to open a FileDialog box and browse for a file and return the filename (maybe I am not understanding the question properly)?
    The procedure below just opens a file picker dialog box and returns the path and file name of the file selected:

Function BrowseForFileName(InitialPath As String) As String

    'Declare a variable as a FileDialog object.
    Dim fd As FileDialog
    'Declare a variable to contain the file name.
    '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
   
    'Create a FileDialog object as a File Picker dialog box.
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    'Use a With...End With block to reference the FileDialog object.
    With fd
        .Title = "Select the file."
        .InitialFileName = InitialPath
        .AllowMultiSelect = False
        'Use the Show method to display the File Picker dialog box and return the selected File Name.
        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 and file name of the file selected.
                BrowseForFileName = vrtSelectedItem

            Next vrtSelectedItem
        Else 'The user pressed Cancel.
            BrowseForFileName = "Cancel"
        End If
    End With

    'Set the object variable to Nothing.
    Set fd = Nothing

End Function
0
 
harfangCommented:
I tried this, but "Application.FileDialog" does not exist in Access 2000. Looks good, though. My Access 2003 is currently locked :) so I can't test any further.
Cheers!
0
 
will_scarlet7Commented:
When you tried it in Access 2000, did you set a reference to the "Office 9 Object Library"?
Sorry I did not mention earlier, but FileDialog is an Office object and not Access specifically.
0
 
leeskelton83Commented:
Here is an easier way. Insert a MS Common Dialog control on your form and refer to it like this.:

Dim ctlget As CommonDialog

Forms!DailyRatingOpts!ctlget.ShowOpen

Path = Forms!DailyRatingOpts!ctlget.FileName

0
 
harfangCommented:
Yes, I did. Still the sample code uses "Application.FileDialog", which means that the host office application is responsible for providing a handle to that object... Probably Access 2002/2003?
0
 
Chi Is CurrentAuthor Commented:
Hello All ~

Thank you all for your thoughtful replies.

I always like simple, as long as it works.  I have more to do today than I thought.  'Will check out your suggestions over the week end.

leeskelton83:  I'm not familiar w/ MS Common Dialog controls, but I'll look it up.  The final result needs to be the file name and path (eg. c:\documents\client\invoice.doc), in a control, with the control source linked to a field.

will_scarlet7: 'Will also try your suggestion.

harfang: Will also investigate your suggestion; though I need to adapt this function to my DB.  'Seems involved...

Again, MANY THANKS - 'Will be back.  Jacob
0
 
leeskelton83Commented:
Yes in this code:
Dim ctlget As CommonDialog

Forms!DailyRatingOpts!ctlget.ShowOpen

Path = Forms!DailyRatingOpts!ctlget.FileName

After you select a file, the variable Path will be your file path.
0
 
Chi Is CurrentAuthor Commented:
leeskelton83 ~

"Insert a MS Common Dialog control" - When I do this, I receive the error message: "You don't have the license required to use this ActiveX control."  I'm using Access 2000 and have a complete install.  How can I "Insert a MS Common Dialog control"?

Additionally, I found an EXCELLENTexample of this solution at:
http://www.access-programmers.co.uk/forums/showthread.php?t=62414, see example contained in hyperlink.zip

Andrew's .mdb runs perfectly; however, I can neither copy / paste his controls into my form, nor create a new MS Common Dialog control.  The solution appears elegantly simple though.  And I would love to implement it.

'Seems close.  Many Thanks, Jacob
0
 
leeskelton83Commented:
I have VB on my machine so I can do it. Apparently you can only use the control at design time if you have the Developer package. If no other Experts  object, you can email me your db to lee.skelton@transplace.com and I will add the control for you and you can add the code.
0
 
Chi Is CurrentAuthor Commented:
Thank you for your offer; however, the db is under developemtn and I'd like to place this browse button on a few forms.  I think it would be an unweildy arrangement.  Would installing MS Visual Basic 6 on my machine, enable inserting a MS Common Dialog control in an Access form?
0
 
leeskelton83Commented:
Yes it would. I only have the learning edition and it works for me. But it didn't before this was installed.
0
 
Chi Is CurrentAuthor Commented:
Hello leeskelton83 -

I just experimented with importing the frmSelect form from Andew Frankum's example hyperlink.mdb found at http://www.access-programmers.co.uk/forums/showthread.php?t=62414, and edithing that form re: properties and to contain my controls.  The Select MS Common Dialog control example runs fine and the form is editable.

In the interim, I think I will go this route, using Andew's form as the template for other forms, as the form permits modification.

It also seems to make sense to put MS Visual Basic 6 on my machine for the future - definitely more economical than the Developer package.  Have you found it adds capability to your Access programming?  Are VB tools available in Access form / report design?

Thank you for your assistance!

Jacob
0
 
leeskelton83Commented:
The only difference was that I had more licensing for ActiveX Controls. Everything else is the same. Good luck and don't forget to accept an answer.
0
 
hgj1357Commented:

leeskelton83:
Yes in this code:
Dim ctlget As CommonDialog

Forms!DailyRatingOpts!ctlget.ShowOpen

Path = Forms!DailyRatingOpts!ctlget.FileName

After you select a file, the variable Path will be your file path.

How do I get the Path to equal 0 (ZERO) if the user selects 'CANCEL' on the dialog box?

Thanks
0
 
hgj1357Commented:
Go to control properties, set error cancel checked YES

In your VBA code, use on error, set field to ZERO
0

Featured Post

Free learning courses: Active Directory Deep Dive

Get a firm grasp on your IT environment when you learn Active Directory best practices with Veeam! Watch all, or choose any amount, of this three-part webinar series to improve your skills. From the basics to virtualization and backup, we got you covered.

  • 5
  • 5
  • 5
  • +4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now