Control similar al DirListBox

[lic_dahool]

Para obtener ese cuadro copia este código en un módulo:

Código:

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

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

Private 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

Const BIF_RETURNONLYFSDIRS = &H1

Function GetFolder(meX As Form, title As String) As String

    Dim Browse_Folder As BROWSEINFO
    Dim Item_ID As Long, Result As Long
    Dim NewPath As String

    Browse_Folder.hOwner = meX.hwnd
    Browse_Folder.lpszTitle = title

    ' The type of folder(s) to return
    Browse_Folder.ulFlags = BIF_RETURNONLYFSDIRS

    Item_ID = SHBrowseForFolder(Browse_Folder)
    NewPath = Space(512)
    Result = SHGetPathFromIDList(ByVal Item_ID, ByVal NewPath)

    GetFolder = Terminador(NewPath)

    If GetFolder <> "" Then
        If Not Right(GetFolder, 1) = "\" Then
            GetFolder = GetFolder & "\"
        End If
    End If
    
End Function

Function Terminador(ByVal VarString As String) As String

    Dim Cero As Integer
    
    Cero = InStr(VarString, Chr$(0))
    If Cero > 0 Then
        Terminador = Left$(VarString, Cero - 1)
    Else
        Terminador = VarString
    End If
    
End Function

Para utilizarlo simplemente:

Código:

DirectorioSeleccionado = GetFolder (Me, "Buscar carpeta ...")

Saludos.