Folder select

[huyhk]

Can I use code to browse a dialog to select folder?

[Nucleus]

From Matt Gates

In a module:

Option Explicit
 
Private Const MAX_PATH = 260
 
Public Enum browseInfoFlags
  BIF_NONE = 0 ' No Flags
  BIF_RETURNONLYFSDIRS = &H1&      ' For finding a folder to start document searching
  BIF_DONTGOBELOWDOMAIN = &H2&     ' For starting the Find Computer
  BIF_STATUSTEXT = &H4&
  BIF_RETURNFSANCESTORS = &H8&
  BIF_EDITBOX = &H10&
  BIF_VALIDATE = &H20&              ' insist on valid result (or CANCEL)
 
  BIF_BROWSEFORCOMPUTER = &H1000&  ' Browsing for Computers.
  BIF_BROWSEFORPRINTER = &H2000&   ' Browsing for Printers
  BIF_BROWSEINCLUDEFILES = &H4000& ' Browsing for Everything
End Enum
 
Private Type BROWSEINFO
   hWndOwner As Long
   pidlRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As browseInfoFlags
   lpfn As Long
   lParam As Long
   iImage As Long
End Type
 
' for SHGetPathFromIDList, pszString must be at least MAX_PATH (260) chars
 
Private Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal ptr As Long)
 
' BrowseForFolder() returns a path if the user picks a good one, or "" if they don't.
Public Function BrowseForFolder(ByVal hWndOwner As Long, Optional ByVal dlgTitle$ = "Please select a folder.", Optional ByVal flags As browseInfoFlags = BIF_RETURNONLYFSDIRS) As String
  Dim bif As BROWSEINFO, pidl As Long, buf$
  
  With bif
    .hWndOwner = hWndOwner
    .pidlRoot = 0          ' desktawp
    .pszDisplayName = Space$(MAX_PATH)
    .lpszTitle = dlgTitle$
    .ulFlags = flags
    .lpfn = 0&
    .lParam = 0&
    .iImage = 0&
  End With
  pidl = SHBrowseForFolder(bif)
  If (pidl = 0) Then Exit Function
  buf$ = Space$(MAX_PATH)
  If (SHGetPathFromIDList(pidl, buf$) = 0) Then
    buf$ = ""
  Else
    buf$ = Left$(buf$, InStr(1, buf$, vbNullChar) - 1)
  End If
  CoTaskMemFree pidl
  BrowseForFolder = buf$
End Function

In a form:

Private Sub Command1_Click()
    Dim strResFolder As String
    strResFolder = BrowseForFolder(hWnd, "Please select a folder.")
    If strResFolder = "" Then
        Call MsgBox("The Cancel button was pressed.", vbExclamation)
    Else
        Call MsgBox("The folder " & strResFolder & " was selected.", vbExclamation)
    End If
End Sub

[crptcblade]

Change the InitDir property

[Matthew Gates]

Option Explicit
 
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 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 Const BIF_RETURNONLYFSDIRS = 1
 
Public Function BrowseForFolder(ByVal lHwnd As Long, ByVal sPrompt As String) As String
    Dim tBI As BROWSEINFO
    Dim lList As Long
    Dim lResult As Long
    Dim sPath As String
    Dim sString As String
    
    sString = Space(260)
    With tBI
        .hwndOwner = lHwnd
        .lpszTitle = lStrCat(sPrompt, Chr(0))
        .pszDisplayName = StrPtr(sString)
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    lList = SHBrowseForFolder(tBI)
    sString = StrConv(sString, vbUnicode)
    If lList Then
        sPath = Space(260)
        lResult = SHGetPathFromIDList(lList, sPath)
        Call CoTaskMemFree(lList)
        sPath = Left$(sPath, InStr(sPath, Chr(0)) - 1)
    End If
    BrowseForFolder = sPath
End Function
 
 
 
Private Sub Command1_Click()
    Msgbox BrowseForFolder(hWnd, "Select Directory..")
End Sub

[Matthew Gates]

Maybe I should retire now..I'm getting to old and slow for this .

[huyhk]

Thanks for the code!
And now I want to set default folder for the dialog.
What i have to do?