Varios metodos para escoger carpetas desde Access Primero. El sencillo, sin especificar ruta inicial: =================================================== 'Comienza Codigo 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 '.pIDLRoot = 15 .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 Fijate en el tipo « pIDLRoot As Long » que yo le tengo tachado para que no se ejecute Si vas poniendo valores 1,2,3,4,5 etc comprobaras que el directorio/carpeta de partida donde se abre el cuadro dialogo de escoger carpeta, va cogiendo los directorios y carpetas especiales de windows Segundo Metodo: Metodo de la API de Access. Posetado por Juan en las news de Access =================================================================================== Este metodo tiene la peculiaridad de que se le puede decir desde que carpeta quiero que empieze a buscar: Private Type OFFICEGETFILENAMEINFO hwndOwner As Long szAppName As String * 255 szDlgTitle As String * 255 szOpenTitle As String * 255 szFile As String * 4096 szInitialDir As String * 255 szFilter As String * 255 nFilterIndex As Long lView As Long flags As Long End Type Private Declare Function GetFileName _ Lib "msaccess.exe" _ Alias "#56" _ (gfni As OFFICEGETFILENAMEINFO, _ ByVal fOpen As Integer) As Long Function fGetFileName(Optional InitialDir As String = "") As String Dim FileInfo As OFFICEGETFILENAMEINFO Dim ret As Long With FileInfo .hwndOwner = hWndAccessApp ' Chr(0) es un caracter nulo de terminación de cadena ' usado en C/C++ .szDlgTitle = "Escoger carpeta" & Chr(0) .szInitialDir = InitialDir & Chr(0) ' con estos parámetros hacemos que se utilice el ' cuadro de diálogo para escoger carpetas .lView = 0 .flags = 32 ret = GetFileName(FileInfo, True) ' el valor -302 es el botón cancelar If ret <> -302 Then fGetFileName = Left(.szFile, InStr(.szFile, Chr(0)) - 1) End If End With End Function ******************************************************************************************************** Tercer metodo: La Api de Windows. Es muy parecido al primer metodo (Un poco mas lioso) ya que este ejemplo tambien me permite escoger a partir de qué carpeta deseo que comience la busqueda: ========================================================================================================== Private Const BIF_STATUSTEXT = &H4& Private Const BIF_RETURNONLYFSDIRS = 1 Private Const BIF_DONTGOBELOWDOMAIN = 2 Private Const MAX_PATH = 260 Private Const WM_USER = &H400 Private Const BFFM_INITIALIZED = 1 Private Const BFFM_SELCHANGED = 2 Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100) Private Const BFFM_SETSELECTION = (WM_USER + 102) Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long Private Type BrowseInfo hWndOwner As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type Private m_CurrentDirectory As String 'The current directory ' Public Function BrowseForFolder(Title As String, StartDir As String) As String 'Opens a Treeview control that displays the directories in a computer Dim lpIDList As Long Dim szTitle As String Dim sBuffer As String Dim tBrowseInfo As BrowseInfo m_CurrentDirectory = StartDir & vbNullChar szTitle = Title With tBrowseInfo .hWndOwner = Access.hWndAccessApp .lpszTitle = lstrcat(szTitle, "") .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_STATUSTEXT .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc) 'get address of function. End With lpIDList = SHBrowseForFolder(tBrowseInfo) If (lpIDList) Then sBuffer = Space(MAX_PATH) SHGetPathFromIDList lpIDList, sBuffer sBuffer = left(sBuffer, InStr(sBuffer, vbNullChar) - 1) BrowseForFolder = sBuffer Else BrowseForFolder = "" End If End Function Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long Dim lpIDList As Long Dim ret As Long Dim sBuffer As String On Error Resume Next 'Sugested by MS to prevent an error from 'propagating back into the calling process. Select Case uMsg Case BFFM_INITIALIZED Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory) Case BFFM_SELCHANGED sBuffer = Space(MAX_PATH) ret = SHGetPathFromIDList(lp, sBuffer) If ret = 1 Then Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer) End If End Select BrowseCallbackProc = 0 End Function ' This function allows you to assign a function pointer to a vaiable. Private Function GetAddressofFunction(add As Long) As Long GetAddressofFunction = add End Function Sub Prueba() 'Probamos el ejemplo BrowseForFolder "Titulo", CurrentProject.Path End Sub