
Gracias.
| ||||
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:
Y despues, solo haces una llamada la funcion: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
Código:
Ojo: la funcion devuelve la ruta completa de la carpeta que seleccionaste.ruta = BrowseForFolder(Me.hWnd, "Selecciona un directorio") Saludos.
__________________ .: Download Day - Ayuda a Firefox a Conseguir un record mundial :. |
| |||
Cita: Muchas Gracias
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:
Y despues, solo haces una llamada la funcion: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
Código:
Ojo: la funcion devuelve la ruta completa de la carpeta que seleccionaste.ruta = BrowseForFolder(Me.hWnd, "Selecciona un directorio") Saludos. ![]() ![]() ![]() |