Ver Mensaje Individual
  #3 (permalink)  
Antiguo 05/11/2005, 13:55
antonio2005pe
 
Fecha de Ingreso: agosto-2005
Ubicación: Peru-Lima
Mensajes: 225
Antigüedad: 18 años, 8 meses
Puntos: 0
Cita:
Iniciado por jc_moty
Bien, eso se puede hacer de dos formas:
1. Te complicas la vida con los controles de visual Basic; ó
2. Haces unas cuantas llamadas a las API de Windows.

Yo he optado por la segunda forma; que a decir verdad es mucho mas facil que la primera. El codigo es este:
Código:
Const MAX_PATH = 255

Private Enum eBIF
    BIF_RETURNONLYFSDIRS = &H1            'Sólo directorios del sistema
    BIF_DONTGOBELOWDOMAIN = &H2           'No incluir carpetas de red
    BIF_STATUSTEXT = &H4
    BIF_RETURNFSANCESTORS = &H8
    BIF_BROWSEFORCOMPUTER = &H1000        'Buscar PCs
    BIF_BROWSEFORPRINTER = &H2000         'Buscar impresoras
End Enum

Private Type BrowseInfo
    hwndOwner               As Long
    pIDLRoot                As Long             'Especifica dónde se empezará a mostrar
    pszDisplayName          As Long
    lpszTitle               As Long
    ulFlags                 As Long
    lpfnCallback            As Long
    lParam                  As Long
    iImage                  As Long
End Type

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

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
        (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Function BrowseForFolder(ByVal hwndOwner As Long, ByVal sPrompt As String, Optional ByVal vFlags As eBIF) As String
    '
    Dim iNull As Integer
    Dim lpIDList As Long
    Dim lResult As Long
    Dim sPath As String
    Dim udtBI As BrowseInfo
    Dim lFlags As Long

    If Not IsMissing(vFlags) Then
        lFlags = CInt(vFlags)
    End If

    With udtBI
        .hwndOwner = hwndOwner
        .lpszTitle = lstrcat(sPrompt, "")
        .ulFlags = lFlags Or BIF_RETURNONLYFSDIRS
    End With

    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        lResult = SHGetPathFromIDList(lpIDList, sPath)
        Call CoTaskMemFree(lpIDList)
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    Else
        'Se ha pulsado en cancelar
        sPath = ""
    End If

    BrowseForFolder = sPath
End Function
Y despues, solo haces una llamada la funcion:
Código:
ruta = BrowseForFolder(Me.hWnd, "Selecciona un directorio")
Ojo: la funcion devuelve la ruta completa de la carpeta que seleccionaste.

Saludos.
Muchas Gracias