Attribute VB_Name = "Browse"
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 Sub CoTaskMemFree Lib "ole32.dll" ( _
  ByVal pv As Long)

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" ( _
  lpBrowseInfo As BROWSEINFO) As Long


Private Declare Function SHGetFileInfo Lib "Shell32" _
  Alias "SHGetFileInfoA" ( _
  ByVal pszPath As Any, _
  ByVal dwFileAttributes As Long, _
  psfi As SHFILEINFO, _
  ByVal cbFileInfo As Long, _
  ByVal uFlags As Long) As Long

Private Type SHITEMID
    cb As Long
    abID() As Byte
End Type

Private Type ITEMIDLIST
    mkid As SHITEMID
End Type

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 SHFILEINFO
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName As String * 260
    szTypeName As String * 80
End Type


Public Function Dialog(Title As String, Ctr As Form) As String
  Dim BI As BROWSEINFO
  Dim nFolder As Long
  Dim IDL As ITEMIDLIST
  Dim pIdl As Long
  Dim SHFI As SHFILEINFO
  Dim sPath As String
  
  With BI
  .hOwner = Ctr.hWnd
  .pszDisplayName = String$(260, 0)
  .lpszTitle = Title
  .ulFlags = &H1
  End With

  pIdl = SHBrowseForFolder(BI)
  If pIdl = 0 Then Exit Function

  sPath = String$(260, 0)
  SHGetPathFromIDList ByVal pIdl, ByVal sPath
  sPath = Left(sPath, InStr(sPath, vbNullChar) - 1)
  CoTaskMemFree pIdl
  
  Dialog = sPath
End Function

