This will list out the Folder, Path, Date Range, Size, and Level. It shows the option for using Early binding as opposed to Late binding, as it uses the FileSystemObject from the Microsoft Scripting Runtime, which you can set by going to Tools, References in the VBE.
Option Explicit
Private FolderCount As Long
Private Const MAXSUBFOLDERS As Long = 2
Sub RecordRetention()
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Early Binding - reference set
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Dim FSO As Scripting.FileSystemObject
' Dim ParentFolder As Scripting.Folder
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Late Binding - no reference set
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FSO As Object
Dim ParentFolder As Object
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FolderChoice As Variant
Dim NewSheet As Worksheet
FolderChoice = BrowseForFolder
If FolderChoice = False Then Exit Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Early Binding - reference set
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Set FSO = New Scripting.FileSystemObject
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Late Binding - no reference set
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Set FSO = CreateObject("Scripting.FileSystemObject")
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Set ParentFolder = FSO.GetFolder(FolderChoice)
Set NewSheet = ActiveSheet ' ThisWorkbook.Worksheets.Add
If WorksheetFunction.CountA(NewSheet.Cells) = 0 Then
NewSheet.Range("A1").Resize(1, 5).Value = Array("Folder", "Path", "Date Range", "Size", "Level")
End If
FolderCount = UBound(Split(ParentFolder.Path, "\"))
Call ListFolderDetails(ParentFolder, NewSheet, 1)
NewSheet.Cells.Font.Size = 11
NewSheet.Cells.EntireColumn.AutoFit
End Sub
Sub ListFolderDetails(ByVal Folder As Object, ByVal TargetSheet As Worksheet, Optional ByVal Level As Long = 1)
'If using Early Binding, use "ByVal Folder As Scripting.Folder" instead of "ByVal Folder As Object"
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Early Binding - reference set
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Dim SubFolder As Scripting.Folder
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Late Binding - no reference set
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim SubFolder As Object
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim SheetRow As Long
If (UBound(Split(Folder.Path, "\")) - FolderCount) > MAXSUBFOLDERS Then Exit Sub
SheetRow = TargetSheet.Cells.Find(What:="*", After:=TargetSheet.Cells(1, 1), LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
TargetSheet.Cells(SheetRow, 1).Value = Folder.Name
TargetSheet.Cells(SheetRow, 2).Value = Folder.Path
TargetSheet.Cells(SheetRow, 3).Value = Format(Folder.DateCreated, "yyyy") & " - " & Format(Folder.DateLastModified, "yyyy")
TargetSheet.Cells(SheetRow, 4).Value = Format(Folder.Size / 1024 / 1024, "#,##0.0 \MB")
TargetSheet.Cells(SheetRow, 5).Value = Level
For Each SubFolder In Folder.SubFolders
Call ListFolderDetails(SubFolder, TargetSheet, UBound(Split(Folder.Path, "\")) - FolderCount + 2)
Next SubFolder
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=284
'
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
'Destroy the Shell Application
Set ShellApp = Nothing
'Check for invalid or non-entries and send to the Invalid error
'handler if found
'Valid selections can begin L: (where L is a letter) or
'\\ (as in \\servername\sharename. All others are invalid
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function
HTH