buenas...

pongo a disposición un código donde en un solo módulo, con 4 apis y una sola función se genera un cuadro de diálogo de seleccionar carpeta:

Código:
  1. 'This module contains all the declarations to use the
  2. 'Windows 95 Shell API to use the browse for folders
  3. 'dialog box. To use the browse for folders dialog box,
  4. 'please call the BrowseForFolders function using the
  5. 'syntax: stringFolderPath=BrowseForFolders(Hwnd,TitleOfDialog)
  6. '
  7. 'For contacting information, see other module
  8.  
  9. Option Explicit
  10.  
  11. Public Type BrowseInfo
  12.      hwndOwner As Long
  13.      pIDLRoot As Long
  14.      pszDisplayName As Long
  15.      lpszTitle As Long
  16.      ulFlags As Long
  17.      lpfnCallback As Long
  18.      lParam As Long
  19.      iImage As Long
  20. End Type
  21.  
  22. Public Const BIF_RETURNONLYFSDIRS = 1
  23. Public Const MAX_PATH = 260
  24.  
  25. Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
  26. Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
  27. Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
  28. Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
  29.  
  30. Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
  31.      
  32.     'declare variables to be used
  33.     Dim iNull As Integer
  34.      Dim lpIDList As Long
  35.      Dim lResult As Long
  36.      Dim sPath As String
  37.      Dim udtBI As BrowseInfo
  38.  
  39.     'initialise variables
  40.     With udtBI
  41.         .hwndOwner = hwndOwner
  42.         .lpszTitle = lstrcat(sPrompt, "")
  43.         .ulFlags = BIF_RETURNONLYFSDIRS
  44.      End With
  45.  
  46.     'Call the browse for folder API
  47.     lpIDList = SHBrowseForFolder(udtBI)
  48.      
  49.     'get the resulting string path
  50.     If lpIDList Then
  51.         sPath = String$(MAX_PATH, 0)
  52.         lResult = SHGetPathFromIDList(lpIDList, sPath)
  53.         Call CoTaskMemFree(lpIDList)
  54.         iNull = InStr(sPath, vbNullChar)
  55.         If iNull Then sPath = Left$(sPath, iNull - 1)
  56.      End If
  57.  
  58.     'If cancel was pressed, sPath = ""
  59.     BrowseForFolder = sPath
  60.  
  61. End Function