Que tal, realmente es muy corto el codigo y funciona EXCELente, ahora, retomando los 2 codigos anteriores de Adrian,agrego un poco mas de codigo pero, creo que tambien queda Bien (way) Ok
- Código: Seleccionar todo
Sub ListarArchivos()
Dim Direc As FileDialog, Ruta As String, oMiObj As Object, oFile As Object, i As Long
Dim oSubCarp As Object, Carp As Object, FSO As Object, FileObject As Object
Set Direc = Application.FileDialog(msoFileDialogFolderPicker)
Range("A2:E" & Rows.Count).ClearContents
If Direc.Show = 0 Then Exit Sub
Ruta = Direc.SelectedItems(1): i = 2
Set oMiObj = CreateObject("Scripting.FileSystemObject")
Set oFile = CreateObject("Scripting.FileSystemObject")
Set oSubCarp = oMiObj.GetFolder(Ruta).SubFolders
Set FSO = CreateObject("Scripting.FileSystemObject")
With oMiObj
For Each oFile In .GetFolder(Ruta).Files
Range("A" & i) = oFile.Name
Set FileObject = FSO.GetFile(Ruta & "\" & oFile.Name)
Cells(i, 2).Value = FSO.GetExtensionName(oFile.Name)
Cells(i, 3).Value = FileObject.DateCreated
Cells(i, 4).Value = FileObject.DateLastAccessed
Cells(i, 5).Value = FileObject.DateLastModified
Set FileObject = Nothing
i = i + 1
Next
For Each Carp In oSubCarp
Range("A" & i) = "[" & Carp.Name & "]"
ListaFile (Ruta & "\" & Carp.Name)
i = Cells(Rows.Count, 1).End(xlUp).Row + 1
Next
End With
Set Direc = Nothing
Set oMiObj = Nothing
Set oFile = Nothing
Set oSubCarp = Nothing
With [A1:E1]
.EntireColumn.AutoFit
.Value = [{"Carp/File","Ext","Created", "Last Accessed", "Last Modoified"}]
.HorizontalAlignment = xlCenter
End With
End Sub
Sub ListaFile(Ruto$)
Dim Direct As FileDialog, oFileT, ia&
Dim FSOd As Object, FileObjD As Object
Set Direct = Application.FileDialog(msoFileDialogFolderPicker)
ia = Cells(Rows.Count, 1).End(xlUp).Row + 1
Set oFileT = CreateObject("Scripting.FileSystemObject")
Set FSOd = CreateObject("Scripting.FileSystemObject")
With CreateObject("Scripting.FileSystemObject")
For Each oFileT In .GetFolder(Ruto).Files
Range("A" & ia) = oFileT.Name
Set FileObjD = FSOd.GetFile(Ruto & "\" & oFileT.Name)
Cells(ia, 2).Value = FSOd.GetExtensionName(oFileT.Name)
Cells(ia, 3).Value = FileObjD.DateCreated
Cells(ia, 4).Value = FileObjD.DateLastAccessed
Cells(ia, 5).Value = FileObjD.DateLastModified
Set FileObjD = Nothing
ia = Cells(Rows.Count, 1).End(xlUp).Row + 1
Next
End With
Set oFileT = Nothing
Set Direct = Nothing
End Sub
