Binaryworld - BrowseFolders - Show the BrowseForFolders standard dialog ... [ VB -> Dialogbox ]

Copy/Paste The following code in form and press F5 to run the demo

Option Explicit

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal _
    hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

Private Type SHITEMID
  cb As Long
  abID As Byte
End Type

Private Type ITEMIDLIST
  mkid As SHITEMID
End Type

Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_STATUSTEXT = &H4
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_BROWSEFORCOMPUTER = &H1000
Private Const BIF_BROWSEFORPRINTER = &H2000

' Show the standard "BrowseForFolder" dialog to select a folder.
' hWnd is the handle of the parent form
' DialogText is an optional message to show on the dialog
'
' Example: MsgBox "You selected " & BrowseFolders(Me.hwnd,
' "Select your favourite folder")

Function BrowseFolders(ByVal hwnd As Long, Optional ByVal DialogText As String = _
  "@@@") As String
  Dim BI As BROWSEINFO
  Dim lID As Long
  Dim szPath As String

  BI.hOwner = hwnd
  ' if specified, set the dialog's descriptive text
  If DialogText <> "@@@" Then BI.lpszTitle = DialogText
  ' return physical folders only
  BI.ulFlags = BIF_RETURNONLYFSDIRS
  szPath = Space$(1024)
  ' show the dialog
  lID = SHBrowseForFolder(BI)

  ' get the path from the returned ID, otherwise return a null string
  If SHGetPathFromIDList(ByVal lID, ByVal szPath) Then
    BrowseFolders = Left$(szPath, InStr(szPath, vbNullChar) - 1)
  End If
End Function

Private Sub Form_Load()
  MsgBox BrowseFolders(Me.hwnd, "Pick Something")
End Sub