Mostrar Carpetas

David Gonzalez
04 de Marzo del 2004
Tengo el codigo para mostrar los archivos de una carpeta :

Dim loFS As Object
Dim f As Object
Dim fc As Object
Dim f1 As Object
Set loFS = CreateObject("Scripting.FileSystemObject")
'poner en vez de c: el directorio en donde estes
Set f = loFS.GetFolder("c:")
Set fc = f.Files
For Each f1 In fc
'debes poner un listbox en el formulario llamado list1
List1.AddItem f1.Name
Next

Pero Necesito mostrar los subdirectorios contenidos en este directorio solo con codigo tal como con los archivos.



a


CristianBallZ
04 de Marzo del 2004
porque no pruebas con un list box un drivelistbox y dirlistbox
te paso un codigo de unformulario que hace algo parecido
Option Explicit
'***********************Formulario que permite buscar archivo de parametros
Private Sub cmd_Aceptar_Click()
On Error GoTo errores:
errores:
'ABRIR ARCHIVO
Unload Me
If Err.Number > 0 Then
MsgBox Err.Description, vbCritical, "Error de I/O"
Resume Next
End If
End Sub
Private Sub cmd_cancelar_Click()
Unload Me
End Sub
Private Sub Dir_archiv_Change()
fil_archiv.Path = Dir_archiv.Path
End Sub
Private Sub Drv_unidad_Change()
Dim res As Integer
On Error GoTo errores:
Dir_archiv.Path = Drv_unidad.Drive
errores:
If Err.Number > 0 Then
' activa unidad c si no estan las unidades disponibles
res = MsgBox(Err.Description, vbCritical + vbRetryCancel, "Error de unidad")
If res = 4 Then
Call Drv_unidad_Change
Else
Drv_unidad.Drive = "c:"
End If
Resume Next
End If
End Sub

Private Sub fil_archiv_Click()
cmd_aceptar.Enabled = True
End Sub

Private Sub fil_archiv_DblClick()
On Error GoTo errores:
cmd_aceptar.Enabled = True
Call cmd_Aceptar_Click
errores:
If Err.Number > 0 Then
MsgBox Err.Description, vbCritical, "error al insertar archivo"
Resume Next
End If
End Sub

Private Sub Form_Load()
' se asume como directorio por defecto el uso de mis documentos
'de no existir este directorio la aplicación busca en la raíz de c
On Error GoTo errores:
Dir_archiv.Path = "c:mis documentos"
fil_archiv.Path = Dir_archiv.Path
errores:
If Err.Number > 0 Then
'puede faltar directorio mis documentos
MsgBox Err.Description + ", no se encontró directorio mis documentos", vbCritical + vbOKOnly, "Error de entrada a unidades"
Dir_archiv.Path = "c:"
fil_archiv.Path = Dir_archiv.Path
Resume Next
End If
End Sub