Path Selection Dialog Box

[Gregg]

I was hoping to use the common dialog box for mere path selection (as opposed to actually having to pick a file)

I'd like a "browse for path" dialog box. Are there any common controls that can do this and return only the path name.

[HeSaidJoe]

'Using the browser dialog box 
'make a reference 

Option Explicit 

Private Const BIF_RETURNONLYFSDIRS = 1 
Private Const BIF_DONTGOBELOWDOMAIN = 2 
Private Const MAX_PATH = 260 

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 lstrcat Lib "kernel32" _ 
Alias "lstrcatA" (ByVal lpString1 As String, ByVal _ 
lpString2 As String) As Long 

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 Sub Form_Load() 
'Opens a Browse Folders Dialog Box that displays the 
'directories in your computer 
Dim lpIDList As Long ' Declare Varibles 
Dim sBuffer As String 
Dim szTitle As String 
Dim tBrowseInfo As BrowseInfo 

szTitle = "Hello World. Click on a directory and " & _ 
"it's path will be displayed in a message box" 
' Text to appear in the the gray area under the title bar 
' telling you what to do 

With tBrowseInfo 
.hWndOwner = Me.hWnd ' Owner Form 
.lpszTitle = lstrcat(szTitle, "") 
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN 
End With 

lpIDList = SHBrowseForFolder(tBrowseInfo) 

If (lpIDList) Then 
sBuffer = Space(MAX_PATH) 
SHGetPathFromIDList lpIDList, sBuffer 
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1) 

' <<< Add Your Code Here >>> 

MsgBox sBuffer 

End If 
End Sub

[Shrog]

This is what I've been using, but I cannot find out how to get the dialog window to start up at a specific directory.

I want to be able to take the user directly to the last selected directory, but instead the dialog starts at the root directory, and the user has to navigate through the directories each time.

Does anybody know how to do this?

Shrog

[faisalkm]

'Paste this code in a Module
 
Public 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
 
Public Declare Function SHBrowseForFolder Lib _
   "shell32.dll" Alias "SHBrowseForFolderA" _
   (lpBrowseInfo As BROWSEINFO) As Long
 
Public Declare Function SHGetPathFromIDList Lib _
   "shell32.dll" Alias "SHGetPathFromIDListA" _
   (ByVal pidl As Long, _
   ByVal pszPath As String) As Long
 
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
 
Public Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
   (ByVal hWnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long
   
Public Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
   (pDest As Any, _
    pSource As Any, _
    ByVal dwLength As Long)
    
Public Const MAX_PATH = 260
Public Const WM_USER = &H400
Public Const BFFM_INITIALIZED = 1
 
'Constants ending in 'A' are for Win95 ANSI
'calls; those ending in 'W' are the wide Unicode
'calls for NT.
 
'Sets the status text to the null-terminated
'string specified by the lParam parameter.
'wParam is ignored and should be set to 0.
Public Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Public Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
 
'If the lParam  parameter is non-zero, enables the
'OK button, or disables it if lParam is zero.
'(docs erroneously said wParam!)
'wParam is ignored and should be set to 0.
Public Const BFFM_ENABLEOK As Long = (WM_USER + 101)
 
'Selects the specified folder. If the wParam
'parameter is FALSE, the lParam parameter is the
'PIDL of the folder to select , or it is the path
'of the folder if wParam is the C value TRUE (or 1).
'Note that after this message is sent, the browse
'dialog receives a subsequent BFFM_SELECTIONCHANGED
'message.
Public Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Public Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
   
 
'specific to the PIDL method
'Undocumented call for the example. IShellFolder's
'ParseDisplayName member function should be used instead.
Public Declare Function SHSimpleIDListFromPath Lib _
   "shell32" Alias "#162" _
   (ByVal szPath As String) As Long
 
 
'specific to the STRING method
Public Declare Function LocalAlloc Lib "kernel32" _
   (ByVal uFlags As Long, _
    ByVal uBytes As Long) As Long
    
Public Declare Function LocalFree Lib "kernel32" _
   (ByVal hMem As Long) As Long
 
Public Declare Function lstrcpyA Lib "kernel32" _
   (lpString1 As Any, lpString2 As Any) As Long
 
Public Declare Function lstrlenA Lib "kernel32" _
   (lpString As Any) As Long
 
Public Const LMEM_FIXED = &H0
Public Const LMEM_ZEROINIT = &H40
Public Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)
 
'windows-defined type OSVERSIONINFO
Public Type OSVERSIONINFO
  OSVSize         As Long
  dwVerMajor      As Long
  dwVerMinor      As Long
  dwBuildNumber   As Long
  PlatformID      As Long
  szCSDVersion    As String * 128
End Type
Public Const VER_PLATFORM_WIN32_NT = 2
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
  (lpVersionInformation As OSVERSIONINFO) As Long
 
 
Public Function BrowseCallbackProcStr(ByVal hWnd As Long, _
                                      ByVal uMsg As Long, _
                                      ByVal lParam As Long, _
                                      ByVal lpData As Long) As Long
                                       
  'Callback for the Browse STRING method.
 
  'On initialization, set the dialog's
  'pre-selected folder from the pointer
  'to the path allocated as bi.lParam,
  'passed back to the callback as lpData param.
 
   Select Case uMsg
      Case BFFM_INITIALIZED
      
         Call SendMessage(hWnd, BFFM_SETSELECTIONA, _
                          True, ByVal lpData)
                          
         Case Else:
         
   End Select
          
End Function
          
 
Public Function BrowseCallbackProc(ByVal hWnd As Long, _
                                   ByVal uMsg As Long, _
                                   ByVal lParam As Long, _
                                   ByVal lpData As Long) As Long
 
  'Callback for the Browse PIDL method.
 
  'On initialization, set the dialog's
  'pre-selected folder using the pidl
  'set as the bi.lParam, and passed back
  'to the callback as lpData param.
 
   Select Case uMsg
      Case BFFM_INITIALIZED
      
         Call SendMessage(hWnd, BFFM_SETSELECTIONA, _
                          False, ByVal lpData)
                          
         Case Else:
         
   End Select
 
End Function
 
 
Public Function FARPROC(ByVal pfn As Long) As Long
  
  'A dummy procedure that receives and returns
  'the value of the AddressOf operator.
 
  'Obtain and set the address of the callback
  'This workaround is needed as you can't assign
  'AddressOf directly to a member of a user-
  'defined type, but you can assign it to another
  'long and use that (as returned here)
 
  FARPROC = pfn
 
End Function
 
'Put this in ur form
 
 
Private Sub Command1_Click()
    BrowseForFolderByPath "c:\Windows"
End Sub
Public Function BrowseForFolderByPath(sSelPath As String) As String
 
  Dim BI As BROWSEINFO
  Dim pidl As Long
  Dim lpSelPath As Long
  Dim sPath As String * MAX_PATH
  
  With BI
    .hOwner = Me.hWnd
    .pidlRoot = 0
    .lpszTitle = "Pre-selecting folder using the folder's string."
    .lpfn = FARPROC(AddressOf BrowseCallbackProcStr)
    
    lpSelPath = LocalAlloc(LPTR, Len(sSelPath) + 1)
    CopyMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath) + 1
    .lParam = lpSelPath
    
    End With
    
   pidl = SHBrowseForFolder(BI)
   
   If pidl Then
     
      If SHGetPathFromIDList(pidl, sPath) Then
         BrowseForFolderByPath = Left$(sPath, InStr(sPath, vbNullChar) - 1)
      End If
      
      Call CoTaskMemFree(pidl)
   
   End If
   
  Call LocalFree(lpSelPath)
 
End Function

Hope this helps u