Using Excel VB to identify when a folder's content was last edited

[scotthannaford1973]

Hi

I have a work folder (lets's call it M:/Acute ) which contains dozens of folders; I can easily do a list of all of the next level folders within that top level folder, but for each of those sub-folders I'd like to know the most recent date when any of it's files (including all files in sub-folders) were edited.

basically, it's a really untidy folder and I want to move all old folders into an archive - so need to show the equivalent of:

Folder Name Last Edited
M:/Acute/Folder1 07/09/2020
M:/Acute/Folder2 12/06/2019

thanks in advance!

 

[alansidman]

Here is some code that gives you the file name, last edit, and file size after selecting the sub folder to analyze.

Sub ListAllFile()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
    Dim sPath As String
    Dim lrA As Long
    Dim lrB As Long

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ws = Worksheets.Add

    'Get the folder object associated with the directory
    sPath = InputBox("What is the full Path to Search?")
    Set objFolder = objFSO.GetFolder(sPath)
    ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & " are:"
    ws.Cells(1, 2).Value = "The files found have modified dates:"
    ws.Cells(1, 3).Value = "The file Size is:"

    'Loop through the Files collection
    For Each objFile In objFolder.Files
    'If objFile.Name Like "*.pdf" Then
        lrA = Range("A" & Rows.Count).End(xlUp).Row
        lrB = Range("B" & Rows.Count).End(xlUp).Row
        ws.Range("A" & lrA + 1).Value = objFile.Name
        ws.Range("B" & lrB + 1).Value = objFile.DateLastModified
        ws.Range("C" & lrB + 1).Value = objFile.Size
    'End If
    Next
    'ws.Cells(2, 1).Delete
    'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing

End Sub

 

[scotthannaford1973]

lovely job - huge thanks

 

[alansidman]

Thanks for the feedback

 

[John_w]

Here's another macro you can try.

Option Explicit

Public Sub List_Folders_Modified_Date()
   
    Dim mainFolder As String
    Dim baseCell As Range, r As Long
    Dim FSO As Scripting.FileSystemObject
    Dim Folder As Scripting.Folder, Subfolder As Scripting.Folder
    Dim latestModified As Date
   
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select main folder"
        If Not .Show Then Exit Sub
        mainFolder = .SelectedItems(1) & "\"
    End With
   
    With ActiveSheet
        .Cells.Clear
        .Range("A1:B1").Value = Array("Folder", "Last Modified")
        Set baseCell = .Range("A2:B2")
        r = 0
    End With
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder(mainFolder)
      
    'Process each top-level subfolder in main folder
   
    For Each Subfolder In Folder.SubFolders
        latestModified = Folder_Latest_Modified(FSO, Subfolder)
        If latestModified > 0 Then
            baseCell.Offset(r).Value = Array(Subfolder.Path, latestModified)
        Else
            baseCell.Offset(r).Value = Array(Subfolder.Path, "Empty")
        End If
        r = r + 1
    Next
   
    MsgBox "Done"
   
End Sub


Private Function Folder_Latest_Modified(FSO As Scripting.FileSystemObject, FSfolder As Scripting.Folder) As Date
  
    Dim File As Scripting.File, Subfolder As Scripting.Folder
    Dim latestModified As Date, subfolderLatestModified As Date
   
    'Look at files in this folder
   
    latestModified = 0
    For Each File In FSfolder.Files
        If File.DateLastModified > latestModified Then latestModified = File.DateLastModified
    Next
   
    'Look at files in subfolders
   
    For Each Subfolder In FSfolder.SubFolders
        subfolderLatestModified = Folder_Latest_Modified(FSO, Subfolder)
        If subfolderLatestModified > latestModified Then latestModified = subfolderLatestModified
    Next

    Folder_Latest_Modified = latestModified
   
End Function