Usando el API de Windows (SHBrowseForFolder)

Otra función del API de Windows que puede darle un "look" más apropiado a nuestras aplicaciones, mostrar el cuadro de diálogo de seleccionar carpetas (o directorios) que usa el propio Windows.

La función del API que se encarga de hacerlo es: SHBrowseForFolder, aunque para poder sacarle el jugo nos tendremos que apoyar en otras funciones, una de ellas no es "redistribuible" y debe estar ya instalada en el sistema, de hecho todas las DLLs del API de Windows ya deben estar instaladas en el sistema... por tanto sólo podremos usar estas funciones si previamente están instaladas... el que avisa.

Dejemos las partes "legalistas" a un lado y vamos a centrarnos en lo que interesa:  saber cómo usarla.

Esta función no es tan "intuitiva" como el resto y se basa, como otras muchas de  la librería Shell, en unos parámetros que se pasan en forma de datos asignados a un tipo definido, en este caso es: Browseinfo.
En este tipo definido (UDT), asignaremos lo que queremos que ese cuadro de diálogo nos muestre, por ejemplo se le puede decir que también nos permita seleccionar ficheros, además de carpetas, el título que queramos que tenga, etc.

Lo que es un poco más complicado de indicarle es el directorio por el que debe empezar a mostrar, (por defecto empieza en el Escritorio); para indicarle el directorio por defecto hay que recurrir a la subclasificación, por suerte, desde la versión 5.0 del Visual Basic es algo más fácil, ya que disponemos de AddressOf, el problema es que la subclasificación se hace asignando a uno de los parámetros del tipo definido la dirección de la función que se encargará de procesar esos mensajes... por desgracia AddressOf no devuelve ningún valor, y lo que necesitamos es poder asignar a una variable la dirección de memoria de una función creada en Visual Basic... ¿Cómo lo solucionaremos? Creando una función que devuelva ese valor... ya verás el código y lo comprenderás mejor.

Aquí tienes el código y una "foto" del formulario de prueba en pleno funcionamiento.

Como puedes comprobar, puedes especificar si quieres empezar a "browsear" por una carpeta determinada y también si quieres seleccionar ficheros, además de poder seleccionar carpetas.

 Nos vemos.
Guillermo
P.S.
Por suerte, con el Visual Basic 6.0 se incluyen los CDs de la MSDN Library de Microsoft, que es de dónde he sacado parte del código que he usado... el problema es que los artículos están en inglés... pero algo es algo...
Espero que te sea de utilidad...

Cambios del 14/May/99:

Haciendo caso del consejo del colega Eduardo Morcillo, aquí te digo los cambios que habría que hacer para poder especificar el título de la ventana, para que no salga el que pone por defecto, en inglés: "Browse for folder", sino el que nosotros queramos.

Lo primero que hay que hacer es añadir un nuevo parámetro a la función BrowseForFolder para que acepte el Caption que queremos mostrar.
También he cambiado la función Callback para que "siempre" sea llamada, de esta forma, si se especifica el path de inicio y/o el título a mostrar, se llamarán a las funciones apropiadas del API.

Para poder cambiar el título de una ventana, sabiendo el "handle" (hWnd), simplemente llamaremos a SetWindowText.

'////////////// ESTE CÓDIGO INSERTALO EN UN MÓDULO BAS ///////////////////
'Módulo con las declaraciones y funciones para BrowseForFolder (12/May/99) '
'©Guillermo 'guille' Som, 1999

Option Explicit

Private sFolderIni As String
Private Const WM_USER = &H400&
Public Const MAX_PATH = 260&
'Tipo para usar con SHBrowseForFolder
Private Type BrowseInfo
hWndOwner As Long ' hWnd del formulario
pIDLRoot As Long ' Especifica el pID de la carpeta inicial
pszDisplayName As String ' Nombre del item seleccionado
lpszTitle As String ' Título a mostrar encima del árbol
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
'Browsing for directory.
Public Const BIF_RETURNONLYFSDIRS = &H1&
Public Const BIF_DONTGOBELOWDOMAIN = &H2&
Public Const BIF_STATUSTEXT = &H4&
Public Const BIF_RETURNFSANCESTORS = &H8&
Public Const BIF_EDITBOX = &H10&
Public Const BIF_VALIDATE = &H20
Public Const BIF_BROWSEFORCOMPUTER = &H1000&
Public Const BIF_BROWSEFORPRINTER = &H2000&
Public Const BIF_BROWSEINCLUDEFILES = &H4000&
'message from browser
Public Const BFFM_INITIALIZED = 1
Public Const BFFM_SELCHANGED = 2
Public Const BFFM_VALIDATEFAILED = 3
Public Const BFFM_VALIDATEFAILEDW = 4&
'messages to browser
Public Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Public Const BFFM_ENABLEOK = (WM_USER + 101)
Public Const BFFM_SETSELECTION = (WM_USER + 102
Public Const BFFM_SETSELECTIONW = (WM_USER + 103&)
Public Const BFFM_SETSTATUSTEXTW = (WM_USER + 104&)

Private Declare Function SHBrowseForFolder Lib
"shell32.dll" (lpbi As BrowseInfo) As Long
Private Declare Sub CoTaskMemFree Lib "OLE32.DLL" (ByVal hMem As Long)

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

Public Function BrowseFolderCallbackProc(ByVal hWndOwner As Long, _
ByVal uMSG As Long, ByVal lParam As Long, ByVal pData As Long) As Long
Dim szDir As String
On Local Error Resume Next
Select Case uMSG
' Este mensaje se enviará cuando se inicia el diálogo
' entonces es cuando hay que indicar el directorio de inicio.
Case BFFM_INITIALIZED
' El path de inicio será el directorio indicado,
' si no se ha asignado, usar el directorio actual
If Len(sFolderIni) Then
szDir = sFolderIni & Chr$(0)
Else
szDir = CurDir$ & Chr$(0)
End If
' WParam será TRUE si se especifica un path.
' será FALSE si se especifica un pIDL.
Call SendMessage(hWndOwner, BFFM_SETSELECTION, 1&, ByVal szDir)
' Este mensaje se produce cuando se cambia el directorio
' Si nuestro form está subclasificado para recibir mensajes,
' puede interceptar el mensaje BFFM_SETSTATUSTEXT
' para mostrar el directorio que se está seleccionando.
Case BFFM_SELCHANGED
szDir = String$(MAX_PATH, 0)
' Notifica a la ventana del directorio actualmente seleccionado,
' (al menos en teoría, ya que no lo hace...)
If SHGetPathFromIDList(lParam, szDir) Then
Call SendMessage(hWndOwner, BFFM_SETSTATUSTEXT, 0&, ByVal szDir)
End If
Call CoTaskMemFree(lParam)
End Select
Err = 0
BrowseFolderCallbackProc = 0
End Function
Public Function rtnAddressOf(lngProc As Long) As Long
' Devuelve la dirección pasada como parámetro
' Esto se usará para asignar a una variable la dirección de una función
' o procedimiento.
' Por ejemplo, si en un tipo definido se asigna a una variable la dirección
' de una función o procedimiento
rtnAddressOf = lngProc
End Function

Public Function BrowseForFolder(ByVal hWndOwner As Long, ByVal sPrompt As String, _
Optional sInitDir As String = "", _
Optional ByVal lFlags As Long = BIF_RETURNONLYFSDIRS) As String
'Muestra el diálogo de selección de directorios de Windows
'Si todo va bien, devuelve el directorio seleccionado
'Si se cancela, se devuelve una cadena vacía y se produce el error 32755
'Los parámetros de entrada:
' El hWnd de la ventana
' El título a mostrar
' Opcionalmente el directorio de inicio
' En lFlags se puede especificar lo que se podrá seleccionar:
' BIF_BROWSEINCLUDEFILES, etc.
' por defecto es: BIF_RETURNONLYFSDIRS
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
On Local Error Resume Next
With udtBI
.hWndOwner = hWndOwner
'Título a mostrar encima del árbol de selección
.lpszTitle = sPrompt & vbNullChar

'Que es lo que debe devolver esta función
.ulFlags = lFlags
.ulFlags = lFlags Or BIF_RETURNONLYFSDIRS
' Si se especifica el directorio por el que se empezará...
If Len(sInitDir) Then
sFolderIni = sInitDir
.lpfnCallback = rtnAddressOf(AddressOf BrowseFolderCallbackProc)
End If
Err = 0
On Local Error GoTo 0
' Mostramos el cuadro de diálogo
lpIDList = SHBrowseForFolder(udtBI)

If lpIDList Then
' Si se ha seleccionado un directorio...
' Obtener el path
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
' Quitar los caracteres nulos del final
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
Else
sPath = ""
With Err
.Source = "MBrowseFolder::BrowseForFolder"
.Number = 32755
.Description = "Cancelada la operación de BrowseForFolder"
End With
End If
BrowseForFolder = sPath
End Function
' Este código insertalo en un formulario que tenga un botón llamado cmdSelDir,
' un TextBox llamado Text1, un CheckBox llamado Check1 y otro llamado chkIncludeFiles
'------------------------------------------------------------------------------
' Ejemplo de BrowseForFolder y asignación del directorio de inicio (12/May/99)
'------------------------------------------------------------------------------
Option Explicit
Private Sub cmdSelDir_Click()
Dim sDir As String
Dim lFlags As Long
lFlags = BIF_RETURNONLYFSDIRS

' Si se quiere seleccionar ficheros
If chkIncludeFiles Then
lFlags = lFlags Or BIF_BROWSEINCLUDEFILES
End If
Err = 0
If Check1 Then
sDir = BrowseForFolder(Me.hWnd, "Seleccionar Directorio empezando en " & Text1, Text1, lFlags)
Else
sDir = BrowseForFolder(Me.hWnd, "Seleccionar Directorio", , lFlags)
End If
If Err = 0 Then
Text1 = sDir
Else
MsgBox "Se ha cancelado la operación, el error devuelto es:" & vbCrLf & _
"Source: " & Err.Source & vbCrLf & "Description: " & Err.Description
End If
Err = 0
End Sub
Private Sub Form_Load()
' Asignamos al Text1 el directorio actual
Text1 = CurDir$ End Sub
'Los cambios a realizar para poder mostrar un título en la ventana de
selección de carpetas:
'En la parte general de declaraciones del módulo BAS:
'Variable para guardar el Caption a mostrar
Private sBFFCaption As String
' Declaración de la función del API para cambiar el título de una ventana
Private Declare Function SetWindowText Lib "user32.dll" Alias "SetWindowTextA" _
( ByVal hWnd As Long, ByVal lpString As String) As Long
' Estas son las dos funciones para "browsear"
' La primera es la función callback, que se encargará de inicializar la ventana de selección
Public Function BrowseFolderCallbackProc(ByVal hWndOwner As Long, _
ByVal uMSG As Long, _
ByVal lParam As Long, _
ByVal pData As Long) As Long
' Llamada CallBack para usar con la función BrowseForFolder (12/May/99)
Dim szDir As String
On Local Error Resume Next
Select Case uMSG
' Este mensaje se enviará cuando se inicia el diálogo,
' entonces es cuando hay que indicar el directorio de inicio.
Case BFFM_INITIALIZED
' Si se ha asignado el path de inicio, empezar por ese path
If Len(sFolderIni) Then
szDir = sFolderIni & Chr$(0)
Call SendMessage(hWndOwner, BFFM_SETSELECTION, 1&, ByVal szDir)
End If

' Si se ha especificado el título de la ventana
If Len(sBFFCaption) Then
Call SetWindowText(hWndOwner, sBFFCaption)
End If
' Este mensaje se produce cuando se cambia el directorio
' Si nuestro form está subclasificado para recibir mensajes,
' puede interceptar el mensaje BFFM_SETSTATUSTEXT
' para mostrar el directorio que se está seleccionando.
Case BFFM_SELCHANGED
szDir = String$(MAX_PATH, 0)
' Notifica a la ventana del directorio actualmente seleccionado,
'(al menos en teoría, ya que no lo hace...)
If SHGetPathFromIDList(lParam, szDir) Then
'Debug.Print szDir
Call SendMessage(hWndOwner, BFFM_SETSTATUSTEXT, 0&, ByVal szDir)
End If
Call CoTaskMemFree(lParam)
End Select
Err = 0
BrowseFolderCallbackProc = 0
End Function
Public Function BrowseForFolder(ByVal hWndOwner As Long, _
ByVal sPrompt As String, _
Optional sInitDir As String = "", _
Optional ByVal lFlags As Long = BIF_RETURNONLYFSDIRS, _
Optional sCaption As String = "") As String
' Muestra el diálogo de selección de directorios de Windows
' Si todo va bien, devuelve el directorio seleccionado
' Si se cancela, se devuelve una cadena vacía y se produce el error 32755
Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
On Local Error Resume Next

With udtBI
.hWndOwner = hWndOwner
' Título a mostrar encima del árbol de selección
.lpszTitle = sPrompt & vbNullChar
' Que es lo que debe devolver esta función
.ulFlags = lFlags
' Asignar el caption de la ventana
sBFFCaption = sCaption
'Asignar la variable que contendrá el directorio de inicio
sFolderIni = sInitDir
' Indicar la función Callback a usar.
' Nota: Esto sólo es necesario si se quiere cambiar el caption
' y especificar el directorio de inicio.
' Como hay que asignar esa dirección a una variable,
' se usa una función "intermedia" que devuelve el valor
' del parámetro pasado... es decir: ¡la dirección de la función!
.lpfnCallback = rtnAddressOf(AddressOf BrowseFolderCallbackProc)
End With
Err = 0
On Local Error GoTo 0
' Mostramos el cuadro de diálogo
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
' Si se ha seleccionado un directorio...
' Obtener el path
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)

' Quitar los caracteres nulos del final
iNull = InStr(sPath, vbNullChar
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
Else
'Si se ha pulsado en cancelar...
'Devolver una cadena vacía y asignar un error
sPath = ""
With Err
.Source = "MBrowseFolder::BrowseForFolder"
.Number = 32755
.Description = "Cancelada la operación de BrowseForFolder"
End With
End If
BrowseForFolder = sPath
End Function
' Este es el código que hay que cambiar en el procedimiento cmdSelDir_Click:
' Si te fijas, sólo tendrás que añadirle al final un parámetro con el título
Err = 0
If Check1 Then
sDir = BrowseForFolder(Me.hWnd, "Seleccionar Directorio empezando en " & Text1, Text1, _
lFlags, "Título de la ventana")
Else
sDir = BrowseForFolder(Me.hWnd, "Seleccionar Directorio", , _
lFlags, "Título de la ventana")
End If