alguien sabe como adaptarlo apra q aparezcan losarchivos tmb y no solo la ruta de carpetas?
'CREE UN BOTON Y UN CUADRO DE TEXTO en un formulario nuevo
Citar
Option Explicit
DefLng A-Z
'DECLARACIONES
' Este es el tipo que se pasa a la función del API SHBroseForFolder
Private Type BROWSEINFO
hWndOwner As Long 'ventana propietaria del dialogo de buscar carpetas
pidlRoot As Long 'puntero al ItemID de la carpeta raíz
pszDisplayName As String 'el nombre mostrado del objeto
lpszTitle As String 'el titulo de la ventana de dialogo
uFlags As Integer 'modificadores - ver abajo
lpfn As Long 'direccion de una funcion "callback" (opcional)
lParam As Long 'para el "callback", no utilizado
iImage As Long 'para el "callback", no utilizado
End Type
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" Alias "SHBrowseForFolderA" (lpbi As BROWSEINFO) As Long
Const BIF_RETURNONLYFSDIRS As Integer = 1 'Devolver sólo directorios del Sistema de Ficheros
'--------------------------------------------------------------------------------------
' Muestra un diálogo de buscar carpetas y devuelve el path a la carpeta escogida
' o una cadena vacía si la operación se canceló. Nótese que este procedimiento sólo
' devuelve carpetas del sistema de ficheros, no carpetas virtuales como Mi Ordenador o
' el Panel de Control
'--------------------------------------------------------------------------------------
Private Function BrowseForFolder(ByVal f_HWnd As Long, Optional lpTitle As Variant) As String
On Error Resume Next
Dim lpiidl As Long, lResult As Long
Dim lpbi As BROWSEINFO
Dim lpszBuf As String
Dim lpszNameSpace As String
lpszBuf = String$(255, Chr$(0))
lpszNameSpace = String$(255, Chr$(0))
'fijar los valores iniciales
With lpbi
.hWndOwner = f_HWnd 'el propietario del diálogo (para operación modal o no modal)
.pidlRoot = vbNullString 'comenzar a partir del Escritorio
.lpszTitle = lpTitle 'el texto por encima del árbol de carpetas (NO el "caption" del diálogo)
.pszDisplayName = lpszBuf 'contendrá al volver el nombre del objeto seleccionado
.uFlags = BIF_RETURNONLYFSDIRS 'devolver sólo carpetas del sistema de ficheros
.lpfn = vbNullString 'no hay función de "callback"
.lParam = 0& 'para el "callback", no utilizado
.iImage = 0& 'para el "callback", no utilizado
End With
' Mostrar el diálogo de buscar carpetas y obtener el puntero al ItemID asociado a la carpeta escogida
lpiidl = SHBrowseForFolder(lpbi)
' Si el usuario canceló el diálogo o ocurrió un error, devolver una cadena vacía
If lpiidl = 0 Then BrowseForFolder = "": Exit Function
' Obtener el path del objeto seleccionado a partir del itemID
lResult = SHGetPathFromIDList(lpiidl, lpszNameSpace)
If lResult = 1 Then 'la función devuelve 1 si tuvo éxito, 0 si hubo algún fallo
' Devolver el path a la carpeta, quitando los caracteres nulos extras
BrowseForFolder = Left$(lpszNameSpace, InStr(lpszNameSpace, Chr$(0)))
End If
End Function
Sub Command1_Click()
Dim ShellPath As String
ShellPath = BrowseForFolder(Me.hWnd, "Escoja una carpeta")
If ShellPath <> "" Then
Text1.Text = Left(ShellPath, Len(ShellPath) - 1)
Else
MsgBox "¡Operación cancelada!"
End If
End Sub
DefLng A-Z
'DECLARACIONES
' Este es el tipo que se pasa a la función del API SHBroseForFolder
Private Type BROWSEINFO
hWndOwner As Long 'ventana propietaria del dialogo de buscar carpetas
pidlRoot As Long 'puntero al ItemID de la carpeta raíz
pszDisplayName As String 'el nombre mostrado del objeto
lpszTitle As String 'el titulo de la ventana de dialogo
uFlags As Integer 'modificadores - ver abajo
lpfn As Long 'direccion de una funcion "callback" (opcional)
lParam As Long 'para el "callback", no utilizado
iImage As Long 'para el "callback", no utilizado
End Type
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" Alias "SHBrowseForFolderA" (lpbi As BROWSEINFO) As Long
Const BIF_RETURNONLYFSDIRS As Integer = 1 'Devolver sólo directorios del Sistema de Ficheros
'--------------------------------------------------------------------------------------
' Muestra un diálogo de buscar carpetas y devuelve el path a la carpeta escogida
' o una cadena vacía si la operación se canceló. Nótese que este procedimiento sólo
' devuelve carpetas del sistema de ficheros, no carpetas virtuales como Mi Ordenador o
' el Panel de Control
'--------------------------------------------------------------------------------------
Private Function BrowseForFolder(ByVal f_HWnd As Long, Optional lpTitle As Variant) As String
On Error Resume Next
Dim lpiidl As Long, lResult As Long
Dim lpbi As BROWSEINFO
Dim lpszBuf As String
Dim lpszNameSpace As String
lpszBuf = String$(255, Chr$(0))
lpszNameSpace = String$(255, Chr$(0))
'fijar los valores iniciales
With lpbi
.hWndOwner = f_HWnd 'el propietario del diálogo (para operación modal o no modal)
.pidlRoot = vbNullString 'comenzar a partir del Escritorio
.lpszTitle = lpTitle 'el texto por encima del árbol de carpetas (NO el "caption" del diálogo)
.pszDisplayName = lpszBuf 'contendrá al volver el nombre del objeto seleccionado
.uFlags = BIF_RETURNONLYFSDIRS 'devolver sólo carpetas del sistema de ficheros
.lpfn = vbNullString 'no hay función de "callback"
.lParam = 0& 'para el "callback", no utilizado
.iImage = 0& 'para el "callback", no utilizado
End With
' Mostrar el diálogo de buscar carpetas y obtener el puntero al ItemID asociado a la carpeta escogida
lpiidl = SHBrowseForFolder(lpbi)
' Si el usuario canceló el diálogo o ocurrió un error, devolver una cadena vacía
If lpiidl = 0 Then BrowseForFolder = "": Exit Function
' Obtener el path del objeto seleccionado a partir del itemID
lResult = SHGetPathFromIDList(lpiidl, lpszNameSpace)
If lResult = 1 Then 'la función devuelve 1 si tuvo éxito, 0 si hubo algún fallo
' Devolver el path a la carpeta, quitando los caracteres nulos extras
BrowseForFolder = Left$(lpszNameSpace, InStr(lpszNameSpace, Chr$(0)))
End If
End Function
Sub Command1_Click()
Dim ShellPath As String
ShellPath = BrowseForFolder(Me.hWnd, "Escoja una carpeta")
If ShellPath <> "" Then
Text1.Text = Left(ShellPath, Len(ShellPath) - 1)
Else
MsgBox "¡Operación cancelada!"
End If
End Sub