Adding a 'Browse' Button

[choward]

Hi People,

i want the user to be able to select a working directory by clicking a 'browse' button. Is this possible in VB?

Thanks,

Chris

 

[Guus2005]

Yes:

Option Compare Database
Option Explicit

Public Enum FileType
    Access = 0
    Excel = 1
End Enum

Public Function SelectFile(strCurDir As String, strDialogTitle As String, intFilter As FileType) As String
   On Error GoTo Err_SelectFile

   Dim fd As FileDialog
   Dim varSelectedItem As Variant
   Dim strFile As String
   
   'Create a FileDialog object as a Folder Picker dialog box.
   Set fd = Application.FileDialog(msoFileDialogFilePicker)
   strFile = ""
   
   With fd
      .Title = strDialogTitle
      .ButtonName = "&Select"
      .InitialView = msoFileDialogViewDetails
      'Add a filter that includes MDB or XLS files and make it the first item in the list.
      .Filters.Clear
      Select Case intFilter
        Case FileType.Access
            .Filters.Add "Access databases", "*.mdb", 1
        Case FileType.Excel
            .Filters.Add "Excel spreadsheet", "*.xls", 1
      End Select
      .Filters.Add "Alle bestanden", "*.*", 2
      'Sets the initial file filter to number 1.
      .FilterIndex = 1
      If .Show = -1 Then
         For Each varSelectedItem In .SelectedItems
            If Len(strFile) > 0 Then
                strFile = strFile & ", " & varSelectedItem
            Else
                strFile = varSelectedItem
            End If
         Next varSelectedItem
      Else
         strFile = ""
      End If
   End With

    SelectFile = strFile
        
    Set fd = Nothing

Exit_SelectFile:
   Set fd = Nothing
   Exit Function

Err_SelectFile:
   ErrorProc Err, Error$, "SelectFile", "basFileDialog"
   Resume Exit_SelectFile

End Function

Public Function StripPath(strFilename As String) As String
' Return path only

   Dim intX As Integer
   Dim intMax As Integer
   Dim strResult As String
   
   intMax = GetParts(strFilename, "\")
   
   strResult = ""
   For intX = 1 To intMax - 1
      strResult = strResult & GetPart(strFilename, "\", intX) & "\"
   Next intX
   
   StripPath = strResult

End Function

Look for the GetPart function elsewhere on this forum.
Enjoy!

 

[Moniker]

Or, a much shorter version that does the same thing:

Private Sub cmdSelectFile_Click()

    Dim dlg As FileDialog
    Dim strFilePath As String

    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)

    With dlg
        If .Show = -1 Then
            strFilePath = .SelectedItems
        End If
    End With
    
    Set dlg = Nothing

End Sub

His does a little more error checking and filtering, but this is the most basic directory picker. Note that both methods use a FileDialog object, so you'll need a reference to Microsoft Office Object Library in your References (Tools -> References from the code window).

 

[CyberLynx]

Or using API functions if you don't want to add References to your Database:

Copy and Paste all code into a separate Database Code Module:

'Declarations used For the BrowseForFolder function.
Private 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
Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Private m_CurrentDirectory As String   'The current directory
'------------------------------------------------------------------------

Public Function BrowseForFolder(ByVal StartPath As String) As String
    Dim iNull As Integer, lpIDList As Long, lResult As Long
    Dim sPath As String, udtBI As BrowseInfo

    m_CurrentDirectory = StartPath & vbNullChar
    With udtBI
        'Set the owner window
        .hWndOwner = Screen.ActiveForm.hWnd
        'lstrcat appends the two strings and returns the memory address
        .lpszTitle = lstrcat("Select the Folder where your desired files reside.", "")
        'Return only if the user selected a directory
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT
        'Get address of function for seting the Start Folder in the dialog.
        .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)
    End With

    'Show the 'Browse for folder' dialog
    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        'Get the path from the IDList
        SHGetPathFromIDList lpIDList, sPath
        'free the block of memory
        CoTaskMemFree lpIDList
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    End If

    BrowseForFolder = sPath
End Function

Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
  Dim lpIDList As Long
  Dim Ret As Long
  Dim sBuffer As String
  
  On Error Resume Next  'Sugested by MS to prevent an error from
                        'propagating back into the calling process.
  Select Case uMsg
    Case BFFM_INITIALIZED
      Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
    Case BFFM_SELCHANGED
      sBuffer = Space(MAX_PATH)
      Ret = SHGetPathFromIDList(lp, sBuffer)
      If Ret = 1 Then
        Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
      End If
  End Select
  BrowseCallbackProc = 0
End Function

' This function allows you to assign a function pointer to a vaiable.
Private Function GetAddressofFunction(add As Long) As Long
  GetAddressofFunction = add
End Function

To use it:

Dim Strg As String
Strg = Application.CurrentProject.Path
Strg = [B]BrowseForFolder([/B]Strg[B])[/B]
MsgBox Strg

A lot more long winded than the versions in the previous posts
.

 

[Moniker]

The only advantage of the API call is that it doesn't care which version of Access you have. For example, If you write your application in Access 2003 (Office Object Library v11) and an Access 2000 (v10 I think) tries to run it, it will probably fail. If all your users are on the same platform, the FileDialog is the better route. If you are writing for an environment where you have to accommodate for the lowest common denominator, go with the API route.

Note that this same this is true when connecting to applications like Excel, Word, etc. Setting up variables as Excel.Application, Word.Application, etc. work great if everyone is on the same platform. If you have mixed platforms, then CreateObject("Excel.Application") covers all the bases for you (assuming they have Excel, or whatever application is in question).

 

[Usher]

CyberLynx

I get an error when compiling the code on line

.lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)

I'm new to VBA and I don't understand what the problem is.

Thanks

 

[boblarson]

Did you put this into a standard (not form) module (just under the Option Compare Database and, if you have it in there the Option Explicit)?

'Declarations used For the BrowseForFolder function.
Private 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
Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Private m_CurrentDirectory As String   'The current directory
'------------------------------------------------------------------------

Public Function BrowseForFolder(ByVal StartPath As String) As String
    Dim iNull As Integer, lpIDList As Long, lResult As Long
    Dim sPath As String, udtBI As BrowseInfo

    m_CurrentDirectory = StartPath & vbNullChar
    With udtBI
        'Set the owner window
        .hWndOwner = Screen.ActiveForm.hWnd
        'lstrcat appends the two strings and returns the memory address
        .lpszTitle = lstrcat("Select the Folder where your desired files reside.", "")
        'Return only if the user selected a directory
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT
        'Get address of function for seting the Start Folder in the dialog.
        .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)
    End With

    'Show the 'Browse for folder' dialog
    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        'Get the path from the IDList
        SHGetPathFromIDList lpIDList, sPath
        'free the block of memory
        CoTaskMemFree lpIDList
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    End If

 

[CyberLynx]

Like Bob said Usher....the code needs to be placed into a Database Code Module...not a Form Code Module. The code within the last code box shown should be placed into a Form Code Module in the OnClick event for a Command button.

 

[jjhill]

Or using API functions if you don't want to add References to your Database:

Copy and Paste all code into a separate Database Code Module:

'Declarations used For the BrowseForFolder function.
Private 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
Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
 
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)
 
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
 
Private m_CurrentDirectory As String   'The current directory
'------------------------------------------------------------------------
 
Public Function BrowseForFolder(ByVal StartPath As String) As String
    Dim iNull As Integer, lpIDList As Long, lResult As Long
    Dim sPath As String, udtBI As BrowseInfo
 
    m_CurrentDirectory = StartPath & vbNullChar
    With udtBI
        'Set the owner window
        .hWndOwner = Screen.ActiveForm.hWnd
        'lstrcat appends the two strings and returns the memory address
        .lpszTitle = lstrcat("Select the Folder where your desired files reside.", "")
        'Return only if the user selected a directory
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT
        'Get address of function for seting the Start Folder in the dialog.
        .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)
    End With
 
    'Show the 'Browse for folder' dialog
    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        'Get the path from the IDList
        SHGetPathFromIDList lpIDList, sPath
        'free the block of memory
        CoTaskMemFree lpIDList
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    End If
 
    BrowseForFolder = sPath
End Function
 
Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
  Dim lpIDList As Long
  Dim Ret As Long
  Dim sBuffer As String
 
  On Error Resume Next  'Sugested by MS to prevent an error from
                        'propagating back into the calling process.
  Select Case uMsg
    Case BFFM_INITIALIZED
      Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
    Case BFFM_SELCHANGED
      sBuffer = Space(MAX_PATH)
      Ret = SHGetPathFromIDList(lp, sBuffer)
      If Ret = 1 Then
        Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
      End If
  End Select
  BrowseCallbackProc = 0
End Function
 
' This function allows you to assign a function pointer to a vaiable.
Private Function GetAddressofFunction(add As Long) As Long
  GetAddressofFunction = add
End Function

To use it:

Dim Strg As String
Strg = Application.CurrentProject.Path
Strg = [B]BrowseForFolder([/B]Strg[B])[/B]
MsgBox Strg

A lot more long winded than the versions in the previous posts
.

How do you place the location (Strg) in the TextBox (InvoiceFileLocation)

 

[j-khosravi]

thanks to boblarson;
some modification on boblarson's code

Caution:
Syntax: AddressOf procedurename
The required procedurename specifies the procedure whose address is to be passed. It must represent a procedure in a standard module module in the project in which the call is made.

Option Explicit

'Declarations used For the BrowseForFolder function.
Private Type BrowseInfo
    hWndOwner As LongPtr
    pIDLRoot As Long
    pszDisplayName As LongPtr
    lpszTitle As LongPtr
    ulFlags As Long
    lpfnCallback As LongPtr
    lParam As LongPtr
    iImage As Long
End Type
Private Const BIF_RETURNONLYFSDIRS As Long = &H1        'Only return file system directories
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2       'Do not include network folders below the domain level in the dialog box's tree view control
Private Const BIF_STATUSTEXT As Long = &H4              'Include a status area in the dialog box
Private Const BIF_RETURNFSANCESTORS As Long = &H8       'Only return file system ancestors
Private Const BIF_EDITBOX As Long = &H10                'v4.71. Include an edit control in the browse dialog box that allows the user to type the name of an item
Private Const BIF_VALIDATE As Long = &H20               'v4.71.If the user types an invalid name into the edit box, the browse dialog box calls the application's BrowseCallbackProc with the BFFM_VALIDATEFAILED message. This flag is ignored if BIF_EDITBOX is not specified
Private Const BIF_NEWDIALOGSTYLE As Long = &H40         'v5.0. Use the new user interface. Setting this flag provides the user with a larger dialog box that can be resized. The dialog box has several new capabilities, including: drag-and-drop capability within the dialog box, reordering, shortcut menus, new folders, delete, and other shortcut menu commands
Private Const BIF_BROWSEINCLUDEURLS As Long = &H80      'v 5.0. The browse dialog box can display URLs. The BIF_USENEWUI and BIF_BROWSEINCLUDEFILES flags must also be set. If any of these three flags are not set, the browser dialog box rejects URLs.
Private Const BIF_USENEWUI As Long = &H40               'v5.0. Use the new user interface, including an edit box. This flag is equivalent to BIF_EDITBOX | BIF_NEWDIALOGSTYLE.
Private Const BIF_UAHINT As Long = &H100                'v6.0. When combined with BIF_NEWDIALOGSTYLE, adds a usage hint to the dialog box, in place of the edit box. BIF_EDITBOX overrides this flag
Private Const BIF_NONEWFOLDERBUTTON As Long = &H200     'v6.0. Do not include the New Folder button in the browse dialog box.
Private Const BIF_NOTRANSLATETARGETS As Long = &H400    'v6.0. When the selected item is a shortcut, return the PIDL of the shortcut itself rather than its target.
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000    'Only return computers. If the user selects anything other than a computer, the OK button is grayed.
Private Const BIF_BROWSEFORPRINTER As Long = &H2000     'Only allow the selection of printers. If the user selects anything other than a printer, the OK button is grayed.
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000   'v4.71. The browse dialog box displays files as well as folders.
Private Const BIF_SHAREABLE As Long = &H8000            'v5.0. The browse dialog box can display sharable resources on remote systems.
Private Const BIF_BROWSEFILEJUNCTIONS As Long = &H10000 'Windows 7 and later. Allow folder junctions such as a library or a compressed file with a .zip file name extension to be browsed.

Private Const MAX_PATH = 260

Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)

Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As LongPtr)
Private Declare PtrSafe Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As LongPtr
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As LongPtr
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As LongPtr, ByVal lpBuffer As String) As Long
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Private m_CurrentDirectory As String   'The current directory
'------------------------------------------------------------------------

Public Function BrowseForFolder(ByRef StartPath As String) As VbMsgBoxResult
    Dim iNull As Integer, lpIDList As LongPtr
    Dim sPath As String, udtBI As BrowseInfo

    m_CurrentDirectory = StartPath & vbNullChar
    With udtBI
        'Set the owner window
        .hWndOwner = Application.hWnd
        'lstrcat appends the two strings and returns the memory address
        .lpszTitle = lstrcat("Select the Folder where your desired files reside.", "")
        'Return only if the user selected a directory
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT
        'Get address of function for seting the Start Folder in the dialog.
        .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)
    End With

    'Show the 'Browse for folder' dialog
    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        'Get the path from the IDList
        SHGetPathFromIDList lpIDList, sPath
        'free the block of memory
        CoTaskMemFree lpIDList
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
        StartPath = Trim(sPath)
        BrowseForFolder = vbOK
    Else
        StartPath = vbNullString
        BrowseForFolder = vbCancel
    End If
End Function

Public Function BrowseCallbackProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
  Dim lpIDList As LongPtr
  Dim Ret As Long
  Dim sBuffer As String
  
  On Error Resume Next  'Sugested by MS to prevent an error from
                        'propagating back into the calling process.
  Select Case uMsg
    Case BFFM_INITIALIZED
      Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
    Case BFFM_SELCHANGED
      sBuffer = Space(MAX_PATH)
      Ret = SHGetPathFromIDList(lp, sBuffer)
      If Ret = 1 Then
        Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
      End If
  End Select
  BrowseCallbackProc = 0
End Function

' This function allows you to assign a function pointer to a vaiable.
Private Function GetAddressofFunction(add As LongPtr) As LongPtr
  GetAddressofFunction = add
End Function

 

[Ashfaque]

Or using API functions if you don't want to add References to your Database:

Copy and Paste all code into a separate Database Code Module:

'Declarations used For the BrowseForFolder function.
Private 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
Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long

Private m_CurrentDirectory As String   'The current directory
'------------------------------------------------------------------------

Public Function BrowseForFolder(ByVal StartPath As String) As String
    Dim iNull As Integer, lpIDList As Long, lResult As Long
    Dim sPath As String, udtBI As BrowseInfo

    m_CurrentDirectory = StartPath & vbNullChar
    With udtBI
        'Set the owner window
        .hWndOwner = Screen.ActiveForm.hWnd
        'lstrcat appends the two strings and returns the memory address
        .lpszTitle = lstrcat("Select the Folder where your desired files reside.", "")
        'Return only if the user selected a directory
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT
        'Get address of function for seting the Start Folder in the dialog.
        .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)
    End With

    'Show the 'Browse for folder' dialog
    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        'Get the path from the IDList
        SHGetPathFromIDList lpIDList, sPath
        'free the block of memory
        CoTaskMemFree lpIDList
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    End If

    BrowseForFolder = sPath
End Function

Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
  Dim lpIDList As Long
  Dim Ret As Long
  Dim sBuffer As String
 
  On Error Resume Next  'Sugested by MS to prevent an error from
                        'propagating back into the calling process.
  Select Case uMsg
    Case BFFM_INITIALIZED
      Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
    Case BFFM_SELCHANGED
      sBuffer = Space(MAX_PATH)
      Ret = SHGetPathFromIDList(lp, sBuffer)
      If Ret = 1 Then
        Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
      End If
  End Select
  BrowseCallbackProc = 0
End Function

' This function allows you to assign a function pointer to a vaiable.
Private Function GetAddressofFunction(add As Long) As Long
  GetAddressofFunction = add
End Function

To use it:

Dim Strg As String
Strg = Application.CurrentProject.Path
Strg = [B]BrowseForFolder([/B]Strg[B])[/B]
MsgBox Strg

A lot more long winded than the versions in the previous posts
.

Do you mean if we copy the above code in a separate module, whichever version we are executing the Access file need to require lib references regardless MDE, MDB, ACCDB Etc....?

 

[Gasman]

Why not try it an see?