Autor Tema: Seleccionar carpeta  (Leído 2247 veces)

Desconectado xavi

  • Administrador
  • Habitual
  • *****
  • Mensajes: 204
Seleccionar carpeta
« en: Abril 13, 2012, 11:43:27 pm »
Palabras clave: API, seleccionar, escoger, capturar, carpeta, directorio
Autor: Juan M. Afán de Ribera
Extraído de: La web del Búho

Pregunta:
Quisiera saber si existe algun OCX para capturar carpeta, es decir el Microsoft Common Dialog 6.0 me captura ficheros pero lo que yo quiero es capturar la ruta de la carpeta. He hecho una chapuzilla con el OCX mencionado, pero me gustaria realizarlo correctamente, gracias

Responde Happy
Para mostrar el cuadro de diálogo "Escojer carpetas" yo uso una API, que creo la saque de una utilidad de Tomas Boixet link

Copia y pega lo siguiente en un módulo estandard

Código: [Seleccionar]
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

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long

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

Const BIF_RETURNONLYFSDIRS = &H1

Function BrowseFolder(szDialogTitle As String) As String
Dim x As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

  With bi
    .hOwner = hWndAccessApp
    .lpszTitle = szDialogTitle
    .ulFlags = BIF_RETURNONLYFSDIRS
  End With
  dwIList = SHBrowseForFolder(bi)
  szPath = Space$(512)
  x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
  If x Then
    wPos = InStr(szPath, Chr(0))
    BrowseFolder = Left$(szPath, wPos - 1)
  Else
    BrowseFolder = ""
  End If

End Function

Después, a modo de ejemplo, puedes llamarla de esta manera:

Código: [Seleccionar]
Sub escogerCarpeta()
Dim carpeta As String

  carpeta = BrowseFolder("Escoja una carpeta")
  MsgBox "La ruta escogida es: " & carpeta

End Sub