Listar archivos de un directorio
Este programa devuelve el nombre de archivo, tamaño y fecha de modificación en el directorio seleccionado y sus subcarpetas.
Sub Srch()
Dim i As Long, z As Long, ws As Worksheet, y As Variant
Dim fLdr As String
y = Application.InputBox("Introduce una extensión de archivo", "Introducción información")
If y = False And Not TypeName(y) = "String" Then Exit Sub
Application.ScreenUpdating = False
fLdr = BrowseForFolderShell
With Application.FileSearch
.NewSearch
.LookIn = fLdr
.SearchSubFolders = True
.Filename = y
Set ws = ThisWorkbook.Worksheets.Add(Sheets(1))
On Error GoTo 1
2: ws.Name = "Resultados de búsqueda"
On Error GoTo 0
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If Left$(.FoundFiles(i), 1) = Left$(fLdr, 1) Then
If CBool(Len(Dir(.FoundFiles(i)))) Then
z = z + 1
ws.Cells(z + 1, 1).Resize(, 3) = _
Array(Dir(.FoundFiles(i)), _
FileLen(.FoundFiles(i)) \ 1000, , _
FileDateTime(.FoundFiles(i)))
ws.Hyperlinks.Add Anchor:=Cells(z + 1, 1), _
Address:=.FoundFiles(i)
End If
End If
Next i
End If
End With
ActiveWindow.DisplayHeadings = False
With ws
With .[a1:c1 ]
.Value = [{"Nombre completo","Kilobytes","Última modificación"}]
.Font.Underline = xlUnderlineStyleSingle
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
End With
.[d1:iv1 ].EntireColumn.Hidden = True
Range(.[a65536 ].End(3)(2), _
.[a65536 ]).EntireRow.Hidden = True
Range(.[a2 ], .[c65536 ]).Sort [a2 ], xlAscending, Header:=xlNo
End With
Application.ScreenUpdating = True
Exit Sub
1: Application.DisplayAlerts = False
Worksheets("FileSearch Results").Delete
Application.DisplayAlerts = True
GoTo 2
End Sub
Si te ha parecido interesante, comparte: Compartir
