Eres un usuario Anonimo. Haz clic aqui para entrar | Registrate

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