List last updated files in each subfolder of a path. 1

[bodo62]

Hello all.

I have following code that works pretty fine listing all files of a path (including subfolders).

I now need to retrieve only information about last modified file from each folder, or even better, that I can choose files modified fro a specific date range.

Can someone help me out, please?

Sub TestListFilesInFolder()
Dim strMapp As String
Workbooks.Add
strMapp = InputBox("Paste search path eg C:\TEMPFILE\")

    Range("A1") = "Filename incl. path"
    Range("B1") = "Parent folder"
    Range("C1") = "File size(bytes)"
    Range("D1") = "File type"
    Range("E1") = "Creation date"
    Range("F1") = "Last accessed"
    Range("G1") = "Last modified"
    Range("H1") = "Attributes"
    Range("I1") = "Short path"
    Range("J1") = "Name"
    Range("K1") = "Short name"
    Range("L1") = "Total qty of characters"
        
    Range("A1:L1").Font.Bold = True
    ListFilesInFolder strMapp, True
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)

    Dim FSO As Scripting.FileSystemObject
    Dim fldMapp As Scripting.Folder, fldUnderMapp As Scripting.Folder
    Dim Fil As Scripting.File
    Dim lngRad As Long

    Application.ScreenUpdating = False
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True

    Set FSO = New Scripting.FileSystemObject
    Set fldMapp = FSO.GetFolder(SourceFolderName)
    lngRad = Range("A65536").End(xlUp).Row + 1
For Each Fil In fldMapp.Files
    Cells(lngRad, 1) = Fil.Path
    Cells(lngRad, 2) = Fil.ParentFolder
    Cells(lngRad, 3) = Fil.Size
    Cells(lngRad, 4) = Fil.Type
    Cells(lngRad, 5) = Fil.DateCreated
    Cells(lngRad, 6) = Fil.DateLastAccessed
    Cells(lngRad, 7) = Fil.DateLastModified
    Cells(lngRad, 8) = Fil.Attributes
    Cells(lngRad, 9) = Fil.ShortPath
    Cells(lngRad, 10) = Fil.Name
    Cells(lngRad, 11) = Fil.ShortName
    Cells(lngRad, 12) = "=LEN(R[-0]C[-11])"
        
  'Shows current search path in Status bar
    Application.StatusBar = "Please be patient, copying information... " & Fil.ShortPath
    lngRad = lngRad + 1
    
Next Fil
    If IncludeSubfolders Then
         For Each fldUnderMapp In fldMapp.SubFolders
            ListFilesInFolder fldUnderMapp.Path, True
         Next fldUnderMapp
    End If
Columns("A:L").AutoFit

Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar

    Cells.Select
    Selection.AutoFilter
    Selection.Columns.AutoFit
    Range("A2").Select
    ActiveWindow.FreezePanes = True
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .PrintGridlines = True
        .RightMargin = Application.CentimetersToPoints(0.5)
        .LeftMargin = Application.CentimetersToPoints(0.5)
        .TopMargin = Application.CentimetersToPoints(1.5)
        .BottomMargin = Application.CentimetersToPoints(0.5)
    End With
    
Set Fil = Nothing
Set fldMapp = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub

 

[JerryKlmns]

Sort on 2nd column ascending and 7th column descending.
Add an extra column with this formula
M3=If (B3 = B4; B3+1;1), for every folder the last modified file results in 1. Filter that value and you 're ready to go.

Other solutions stand but you need many modifications to your working code.