Seleccionar una carpeta e incluso ficheros
usando el API de Windows (SHBrowseForFolder)

 

Publicado: 12/May/99
Actualizado: 14/May/99 (ver comentario sobre la modificación)


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.

He dejado el código tal y como estaba originalmente, si quieres ver los cambios, están al final.


browsefolder.gif (10085 bytes)

'
'//////////////////////////////////////////////////////////////////////////////
'/////               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

'//////////////////////////////////////////////////////////////////////////////
' Variables, constantes y funciones para usar con BrowseForFolder   (12/May/99)
'//////////////////////////////////////////////////////////////////////////////
'
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             ' Función CallBack
    lParam                  As Long             ' Información extra a pasar a la función Callback
    iImage                  As Long             '
End Type
'
'// Browsing for directory.
Public Const BIF_RETURNONLYFSDIRS = &H1&       '// For finding a folder to start document searching
Public Const BIF_DONTGOBELOWDOMAIN = &H2&      '// For starting the Find Computer
Public Const BIF_STATUSTEXT = &H4&
Public Const BIF_RETURNFSANCESTORS = &H8&
Public Const BIF_EDITBOX = &H10&
Public Const BIF_VALIDATE = &H20&              '// insist on valid result (or CANCEL)
'
Public Const BIF_BROWSEFORCOMPUTER = &H1000&   '// Browsing for Computers.
Public Const BIF_BROWSEFORPRINTER = &H2000&    '// Browsing for Printers
Public Const BIF_BROWSEINCLUDEFILES = &H4000&  '// Browsing for Everything
'
'// message from browser
Public Const BFFM_INITIALIZED = 1
Public Const BFFM_SELCHANGED = 2
Public Const BFFM_VALIDATEFAILED = 3          '// lParam:szPath ret:1(cont),0(EndDialog)
'Public Const BFFM_VALIDATEFAILEDW = 4&         '// lParam:wzPath ret:1(cont),0(EndDialog)
'
'// 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
    ' 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
        ' 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
            'Debug.Print szDir
            Call SendMessage(hWndOwner, BFFM_SETSTATUSTEXT, 0&, ByVal szDir)
        End If
        Call CoTaskMemFree(lParam)
    End Select

    Err = 0
    BrowseFolderCallbackProc = 0

'------------------------------------------------------------------------------
' Este es el código de C en el que está basada esta función Callback
' Código obtenido de la MSDN Library de Microsoft:
' HOWTO: Browse for Folders from the Current Directory
' Article ID: Q179378
'
'         TCHAR szDir[MAX_PATH];
'
'         switch(uMsg) {
'            case BFFM_INITIALIZED: {
'               if GetCurrentDirectory(sizeof(szDir)/sizeof(TCHAR),
'                                      szDir)) {
'                  // WParam is TRUE since you are passing a path.
'                  // It would be FALSE if you were passing a pidl.
'                  SendMessage(hwnd,BFFM_SETSELECTION,TRUE,(LPARAM)szDir);
'               }
'               break;
'            }
'            case BFFM_SELCHANGED: {
'               // Set the status window to the currently selected path.
'               if (SHGetPathFromIDList((LPITEMIDLIST) lp ,szDir)) {
'                  SendMessage(hwnd,BFFM_SETSTATUSTEXT,0,(LPARAM)szDir);
'               }
'               break;
'            }
'           default:
'               break;
'         }
'         return 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
            ' Asignar la variable que contendrá el directorio de inicio
            sFolderIni = sInitDir
            ' Indicar la función Callback a usar.
            ' 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 If
    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 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)
'
' ©Guillermo 'guille' Som, 1999
'------------------------------------------------------------------------------
Option Explicit


Private Sub cmdSelDir_Click()
    ' Muestra el diálogo de seleccionar directorio
    ' Si se marca el Check1, se empezará por el directorio indicado

    Dim sDir As String
    Dim lFlags As Long

    ' Para saber si se ha producido el "error" al cancelar...
    ' no es necesrio interceptar errores:
    'On Local Error Resume Next

    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

    ' Pero si es conveniente poner de nuevo el valor a cero
    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)
            ' WParam  será TRUE  si se especifica un path.
            '         será FALSE si se especifica un pIDL.
            Call SendMessage(hWndOwner, BFFM_SETSELECTION, 1&, ByVal szDir)
        End If

        ' Si se ha especificado el título de la ventana
        If Len(sBFFCaption) Then
            ' Cambiar el título de la ventana.
            ' Aunque parezca que se cambia el título de la ventana "propietaria",
            ' realmente se cambia el de la ventana de selección.
            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
    '
    ' Los parámetros de entrada:
    '   El hWnd de la ventana
    '   El título a mostrar encima del árbol
    '   Opcionalmente el directorio de inicio
    '   En lFlags se puede especificar lo que se podrá seleccionar:
    '       BIF_BROWSEINCLUDEFILES, etc.
    '       por defecto es: BIF_RETURNONLYFSDIRS
    '   El Caption de la ventana
    '
    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 de la ventana.


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


la Luna del Guille o... el Guille que está en la Luna... tanto monta...