Building a VBA-Powered Batch File Rename and Folder Inventory Engine: Automate Directory Traversal, File Metadata Extraction, and Structured Reporting Directly from Excel

Introduction

Picture this: your team has just wrapped up a year-end data project, and you're staring at a shared network drive with 1,400 files scattered across 23 folders. Half of them have names like final_v3_ACTUAL_USE_THIS_one.xlsx, timestamps are inconsistent, and nobody can tell you which reports belong to which client. You need a folder inventory — fast — and you also need to rename about 300 of those files according to a naming convention that someone wrote in a spreadsheet two months ago.

You could click through Windows Explorer for the next four hours, or you could build a VBA engine that does the whole job in under two minutes while you drink your coffee.

That's what this lesson is about. We're going to build a complete, production-grade batch file rename and folder inventory system directly inside Excel. The engine will traverse entire directory trees recursively, extract file metadata (name, size, type, dates, path), log everything to a structured worksheet, and then apply batch rename operations from a lookup table — all with rollback capability so nothing gets destroyed by accident.

By the end of this lesson, you'll have a tool you can drop into any Excel workbook and immediately deploy against real file systems.

What you'll learn:

• How to traverse directory trees recursively using VBA's FileSystemObject and the Dir() function
• How to extract and display rich file metadata including size, dates, and attributes
• How to build a structured inventory report with filtering and conditional formatting applied programmatically
• How to execute batch rename operations from an Excel mapping table with full audit logging
• How to handle errors gracefully so a single bad file doesn't crash a 1,400-file operation

---

Prerequisites

This lesson is pitched at practitioners. You should already be comfortable with:

• Writing and running VBA macros in the Visual Basic Editor — if you need a refresher, see Getting Started with VBA Macros in Excel
• VBA variables, loops, and conditional logic — the fundamentals covered in VBA Variables, Data Types, and Control Structures: Building Robust Excel Automation
• Working with worksheet ranges and cells programmatically — covered in Working with Ranges, Cells, and Worksheets in VBA for Data Professionals
• Basic error handling concepts — you'll benefit from Error Handling and Debugging VBA Code Like a Pro

You do not need prior experience with the FileSystemObject or Windows file system APIs.

---

Understanding the FileSystemObject vs. Dir()

Before writing a single line of code, you need to understand the two main tools VBA gives you for working with the file system: FileSystemObject (FSO) and the native Dir() function. They both work, but they have meaningfully different characteristics.

Dir() is a built-in VBA function. It's fast and doesn't require any additional references. The catch is that it uses a stateful, single-traversal pattern — you call Dir(path) to start, then call Dir() with no arguments to get subsequent files. This means you cannot recursively call Dir() while another Dir() loop is in progress without resetting state, which makes recursive directory traversal genuinely tricky.

FileSystemObject is a COM library (Microsoft Scripting Runtime) that gives you full object-oriented access to drives, folders, and files. It's slightly slower for massive operations, but the object model is clean, recursive traversal is natural, and you get richer metadata with less code. For this engine, we'll use FSO for the inventory and recursive traversal, then discuss where Dir() still earns its place.

To use FSO, you can either add a reference or use late binding. For a tool you'll deploy to other machines, late binding is safer:

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

---

Architecting the Engine: Sheets and Structure

A well-designed tool needs a clear data architecture. We'll use three worksheets:

Sheet 1 — Inventory: The output of the directory scan. Each row represents one file, with columns for full path, folder path, file name, extension, size (KB), date created, date last modified, and a "Flagged" column for files matching rename criteria.

Sheet 2 — RenameMap: A two-column table where column A contains the current file name (or a pattern) and column B contains the new file name. The engine reads this table to execute renames.

Sheet 3 — AuditLog: A timestamped record of every rename operation attempted, with status (Success / Failed) and error message if applicable. This is your rollback trail.

Let's set these sheets up programmatically so the tool is self-contained:

Sub InitializeSheets()
    Dim ws As Worksheet
    Dim sheetNames As Variant
    Dim i As Integer
    
    sheetNames = Array("Inventory", "RenameMap", "AuditLog")
    
    ' Remove existing sheets to start fresh
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Control" Then ws.Delete
    Next ws
    Application.DisplayAlerts = True
    
    ' Create sheets in order
    For i = 0 To 2
        Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        ws.Name = sheetNames(i)
    Next i
    
    ' Set up Inventory headers
    With ThisWorkbook.Worksheets("Inventory")
        Dim headers As Variant
        headers = Array("Full Path", "Folder Path", "File Name", "Extension", _
                        "Size (KB)", "Date Created", "Date Modified", _
                        "Attributes", "Flagged for Rename")
        Dim col As Integer
        For col = 0 To UBound(headers)
            .Cells(1, col + 1).Value = headers(col)
            .Cells(1, col + 1).Font.Bold = True
        Next col
        .Rows(1).Interior.Color = RGB(31, 73, 125)
        .Rows(1).Font.Color = RGB(255, 255, 255)
    End With
    
    ' Set up RenameMap headers
    With ThisWorkbook.Worksheets("RenameMap")
        .Cells(1, 1).Value = "Current Name"
        .Cells(1, 2).Value = "New Name"
        .Rows(1).Font.Bold = True
        .Rows(1).Interior.Color = RGB(31, 73, 125)
        .Rows(1).Font.Color = RGB(255, 255, 255)
    End With
    
    ' Set up AuditLog headers
    With ThisWorkbook.Worksheets("AuditLog")
        Dim auditHeaders As Variant
        auditHeaders = Array("Timestamp", "Original Path", "New Path", "Status", "Error Message")
        For col = 0 To UBound(auditHeaders)
            .Cells(1, col + 1).Value = auditHeaders(col)
            .Cells(1, col + 1).Font.Bold = True
        Next col
        .Rows(1).Interior.Color = RGB(31, 73, 125)
        .Rows(1).Font.Color = RGB(255, 255, 255)
    End With
    
    MsgBox "Sheets initialized. Add a 'Control' sheet manually or rename an existing sheet.", vbInformation
End Sub

---

Building the Recursive Directory Traversal Engine

This is the heart of the tool. The key insight about recursive directory traversal is that you need a procedure that can call itself — each time it encounters a subfolder, it dives into that subfolder and runs the same logic before returning to the parent level.

Here's the complete recursive traversal engine:

' Module-level variables for performance
Private inventoryRow As Long
Private fso As Object
Private invSheet As Worksheet

Sub ScanDirectory()
    Dim targetFolder As String
    
    ' Prompt user for folder path
    targetFolder = InputBox("Enter the full path of the folder to scan:" & vbCrLf & _
                            "Example: C:\Projects\ClientReports\2024", _
                            "Directory Scanner", "C:\")
    
    If Len(Trim(targetFolder)) = 0 Then Exit Sub
    
    ' Validate path
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(targetFolder) Then
        MsgBox "Folder not found: " & targetFolder, vbCritical
        Exit Sub
    End If
    
    ' Clear existing inventory data (keep headers)
    Set invSheet = ThisWorkbook.Worksheets("Inventory")
    If invSheet.Cells(2, 1).Value <> "" Then
        invSheet.Rows("2:" & invSheet.Rows.Count).ClearContents
    End If
    
    ' Initialize row counter
    inventoryRow = 2
    
    ' Freeze screen and boost performance
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = "Scanning: " & targetFolder
    
    ' Start recursive traversal
    Dim startTime As Double
    startTime = Timer
    
    On Error GoTo ScanError
    TraverseFolder fso.GetFolder(targetFolder)
    
    ' Auto-fit columns and add filter
    invSheet.Rows(1).AutoFilter
    invSheet.Columns("A:I").AutoFit
    
    ' Format date columns
    invSheet.Columns("F:G").NumberFormat = "yyyy-mm-dd hh:mm:ss"
    
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "Scan complete. " & (inventoryRow - 2) & " files found in " & _
           Format(Timer - startTime, "0.0") & " seconds.", vbInformation
    Exit Sub
    
ScanError:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
    MsgBox "Error during scan: " & Err.Description, vbCritical
End Sub

Private Sub TraverseFolder(ByVal folder As Object)
    Dim file As Object
    Dim subFolder As Object
    
    ' Process all files in this folder
    For Each file In folder.Files
        On Error Resume Next  ' Handle locked/inaccessible files gracefully
        WriteFileToInventory file
        On Error GoTo 0
    Next file
    
    ' Update status bar so user knows we're alive
    Application.StatusBar = "Scanning: " & folder.Path & " (" & (inventoryRow - 2) & " files found)"
    
    ' Recurse into subfolders
    For Each subFolder In folder.SubFolders
        On Error Resume Next  ' Skip inaccessible system folders
        TraverseFolder subFolder
        On Error GoTo 0
    Next subFolder
End Sub

Private Sub WriteFileToInventory(ByVal file As Object)
    Dim sizeKB As Double
    Dim attributes As String
    
    sizeKB = Round(file.Size / 1024, 2)
    attributes = GetFileAttributes(file)
    
    With invSheet
        .Cells(inventoryRow, 1).Value = file.Path
        .Cells(inventoryRow, 2).Value = file.ParentFolder.Path
        .Cells(inventoryRow, 3).Value = file.Name
        .Cells(inventoryRow, 4).Value = LCase(fso.GetExtensionName(file.Name))
        .Cells(inventoryRow, 5).Value = sizeKB
        .Cells(inventoryRow, 6).Value = CDate(file.DateCreated)
        .Cells(inventoryRow, 7).Value = CDate(file.DateLastModified)
        .Cells(inventoryRow, 8).Value = attributes
        .Cells(inventoryRow, 9).Value = ""  ' Rename flag — populated later
    End With
    
    inventoryRow = inventoryRow + 1
End Sub

Private Function GetFileAttributes(ByVal file As Object) As String
    ' FSO Attributes: 0=Normal, 1=ReadOnly, 2=Hidden, 4=System, 32=Archive
    Dim attr As Integer
    Dim parts() As String
    Dim count As Integer
    
    attr = file.Attributes
    ReDim parts(4)
    count = 0
    
    If (attr And 1) Then parts(count) = "ReadOnly":  count = count + 1
    If (attr And 2) Then parts(count) = "Hidden":    count = count + 1
    If (attr And 4) Then parts(count) = "System":    count = count + 1
    If (attr And 32) Then parts(count) = "Archive":  count = count + 1
    
    If count = 0 Then
        GetFileAttributes = "Normal"
    Else
        ReDim Preserve parts(count - 1)
        GetFileAttributes = Join(parts, ", ")
    End If
End Function

Notice the On Error Resume Next placed tightly around just the two calls that might fail — WriteFileToInventory and TraverseFolder for subfolders. This is intentional. We don't want to silently suppress all errors in the entire procedure; we only want to skip over individual locked files or protected system folders without halting the whole scan. This is a critical pattern in production file system automation.

---

Extracting Rich File Metadata

The basic FSO file object gives us Name, Size, DateCreated, DateLastModified, and Attributes. But in production scenarios, you often need more — particularly the file owner, or for Office files, properties like Author and Last Modified By.

For file owner, we need to drop into the Windows Shell API. Here's a helper function that uses the Shell.Application object:

Private Function GetFileOwner(ByVal filePath As String) As String
    On Error GoTo OwnerError
    
    Dim shell As Object
    Dim folder As Object
    Dim folderItem As Object
    Dim parentPath As String
    Dim fileName As String
    
    Set shell = CreateObject("Shell.Application")
    parentPath = Left(filePath, InStrRev(filePath, "\") - 1)
    fileName = Mid(filePath, InStrRev(filePath, "\") + 1)
    
    Set folder = shell.Namespace(parentPath)
    Set folderItem = folder.ParseName(fileName)
    
    ' Column 8 in Shell namespace is Owner
    GetFileOwner = folder.GetDetailsOf(folderItem, 8)
    Exit Function
    
OwnerError:
    GetFileOwner = "Unknown"
End Function

For Office file properties (.xlsx, .docx, .pptx), you can open the file invisibly and read its BuiltinDocumentProperties. Be careful with this — opening 1,400 Excel files just to read metadata is slow. Apply this only when you've filtered the inventory down to Office files:

Private Function GetExcelAuthor(ByVal filePath As String) As String
    On Error GoTo AuthorError
    
    Dim wb As Workbook
    Set wb = Workbooks.Open(filePath, ReadOnly:=True, UpdateLinks:=False, Notify:=False)
    GetExcelAuthor = wb.BuiltinDocumentProperties("Author").Value
    wb.Close SaveChanges:=False
    Exit Function
    
AuthorError:
    GetExcelAuthor = "N/A"
End Function

---

Building the Rename Mapping System

Now for the second major capability: batch renaming from an Excel table. The design is straightforward — you populate the RenameMap sheet with two columns, and the engine matches files in the Inventory sheet and executes the renames.

We support three matching modes, controlled by a cell on a Control sheet:

1. Exact match — Current Name column exactly matches the file name
2. Contains match — the file name contains the string in Current Name
3. Regex match — full regular expression matching using VBScript's RegExp object

Here's the complete rename engine:

Sub ExecuteBatchRename()
    Dim renameSheet As Worksheet
    Dim auditSheet As Worksheet
    Dim invSheet As Worksheet
    Dim renameMap As Object  ' Scripting.Dictionary for fast lookups
    Dim lastRenameRow As Long
    Dim lastInvRow As Long
    Dim i As Long
    Dim j As Long
    Dim currentName As String
    Dim newName As String
    Dim currentPath As String
    Dim newPath As String
    Dim matchMode As String
    Dim successCount As Long
    Dim failCount As Long
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set renameSheet = ThisWorkbook.Worksheets("RenameMap")
    Set auditSheet = ThisWorkbook.Worksheets("AuditLog")
    Set invSheet = ThisWorkbook.Worksheets("Inventory")
    Set renameMap = CreateObject("Scripting.Dictionary")
    
    ' Read match mode from Control sheet (or default to Exact)
    On Error Resume Next
    matchMode = ThisWorkbook.Worksheets("Control").Range("B2").Value
    On Error GoTo 0
    If Len(matchMode) = 0 Then matchMode = "Exact"
    
    ' Load rename map into dictionary for O(1) lookups
    lastRenameRow = renameSheet.Cells(renameSheet.Rows.Count, 1).End(xlUp).Row
    If lastRenameRow < 2 Then
        MsgBox "RenameMap sheet is empty. Add current and new names before running.", vbExclamation
        Exit Sub
    End If
    
    For i = 2 To lastRenameRow
        currentName = Trim(renameSheet.Cells(i, 1).Value)
        newName = Trim(renameSheet.Cells(i, 2).Value)
        If Len(currentName) > 0 And Len(newName) > 0 Then
            renameMap(LCase(currentName)) = newName
        End If
    Next i
    
    ' Confirm before proceeding
    Dim confirmMsg As String
    confirmMsg = "About to rename files using " & renameMap.Count & " mapping rules." & vbCrLf & _
                 "Match mode: " & matchMode & vbCrLf & vbCrLf & _
                 "This will rename actual files on disk. Proceed?"
    If MsgBox(confirmMsg, vbYesNo + vbExclamation, "Confirm Batch Rename") = vbNo Then Exit Sub
    
    ' Process inventory
    Application.ScreenUpdating = False
    lastInvRow = invSheet.Cells(invSheet.Rows.Count, 1).End(xlUp).Row
    
    ' Find next audit row
    Dim auditRow As Long
    auditRow = auditSheet.Cells(auditSheet.Rows.Count, 1).End(xlUp).Row + 1
    
    successCount = 0
    failCount = 0
    
    For i = 2 To lastInvRow
        currentPath = invSheet.Cells(i, 1).Value
        currentName = invSheet.Cells(i, 3).Value
        
        If Len(currentPath) = 0 Then GoTo NextFile
        
        ' Find matching rename rule
        newName = FindRenameMatch(currentName, renameMap, matchMode)
        
        If Len(newName) = 0 Then GoTo NextFile
        
        ' Build new full path
        newPath = invSheet.Cells(i, 2).Value & "\" & newName
        
        ' Attempt rename
        On Error Resume Next
        fso.MoveFile currentPath, newPath
        
        Dim renameErr As Long
        Dim renameErrDesc As String
        renameErr = Err.Number
        renameErrDesc = Err.Description
        On Error GoTo 0
        
        ' Log to audit sheet
        auditSheet.Cells(auditRow, 1).Value = Now()
        auditSheet.Cells(auditRow, 2).Value = currentPath
        auditSheet.Cells(auditRow, 3).Value = newPath
        
        If renameErr = 0 Then
            auditSheet.Cells(auditRow, 4).Value = "Success"
            auditSheet.Cells(auditRow, 4).Interior.Color = RGB(198, 239, 206)
            ' Update inventory to reflect new name
            invSheet.Cells(i, 1).Value = newPath
            invSheet.Cells(i, 3).Value = newName
            invSheet.Cells(i, 9).Value = "Renamed"
            successCount = successCount + 1
        Else
            auditSheet.Cells(auditRow, 4).Value = "Failed"
            auditSheet.Cells(auditRow, 5).Value = renameErrDesc
            auditSheet.Cells(auditRow, 4).Interior.Color = RGB(255, 199, 206)
            failCount = failCount + 1
        End If
        
        auditRow = auditRow + 1
        
NextFile:
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "Batch rename complete." & vbCrLf & _
           "Successful: " & successCount & vbCrLf & _
           "Failed: " & failCount & vbCrLf & _
           "See AuditLog sheet for details.", vbInformation
End Sub

Private Function FindRenameMatch(ByVal fileName As String, _
                                  ByVal renameMap As Object, _
                                  ByVal matchMode As String) As String
    Dim key As Variant
    
    Select Case UCase(matchMode)
        Case "EXACT"
            If renameMap.Exists(LCase(fileName)) Then
                FindRenameMatch = renameMap(LCase(fileName))
            End If
            
        Case "CONTAINS"
            For Each key In renameMap.Keys
                If InStr(LCase(fileName), key) > 0 Then
                    FindRenameMatch = renameMap(key)
                    Exit Function
                End If
            Next key
            
        Case "REGEX"
            Dim regex As Object
            Set regex = CreateObject("VBScript.RegExp")
            regex.IgnoreCase = True
            For Each key In renameMap.Keys
                regex.Pattern = key
                If regex.Test(fileName) Then
                    ' Support capture group substitution
                    FindRenameMatch = regex.Replace(fileName, renameMap(key))
                    Exit Function
                End If
            Next key
    End Select
End Function

The Scripting.Dictionary for the rename map is an important performance choice. With a dictionary, every file name lookup is O(1) regardless of how many rules you have. If you used a nested loop — scan every file against every rule — you'd hit O(n×m) complexity that becomes painful at scale. This is the kind of data structure thinking that separates production VBA from quick-and-dirty macros, and it's covered in depth in VBA Arrays and Collections for Efficient Data Processing.

---

Generating the Structured Inventory Report

A flat list of file data is useful, but a structured report with summary statistics and conditional formatting is what stakeholders actually want to see. Let's add a reporting procedure that generates a summary section above the data.

Sub GenerateInventoryReport()
    Dim invSheet As Worksheet
    Dim summarySheet As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    Set invSheet = ThisWorkbook.Worksheets("Inventory")
    lastRow = invSheet.Cells(invSheet.Rows.Count, 1).End(xlUp).Row
    
    If lastRow < 2 Then
        MsgBox "Run a directory scan first.", vbExclamation
        Exit Sub
    End If
    
    ' Create or clear Summary sheet
    On Error Resume Next
    Set summarySheet = ThisWorkbook.Worksheets("Summary")
    On Error GoTo 0
    
    If summarySheet Is Nothing Then
        Set summarySheet = ThisWorkbook.Worksheets.Add(Before:=ThisWorkbook.Sheets(1))
        summarySheet.Name = "Summary"
    Else
        summarySheet.Cells.Clear
    End If
    
    ' --- Summary Statistics ---
    With summarySheet
        .Range("A1").Value = "Directory Inventory Report"
        .Range("A1").Font.Size = 16
        .Range("A1").Font.Bold = True
        
        .Range("A3").Value = "Generated:"
        .Range("B3").Value = Now()
        .Range("B3").NumberFormat = "yyyy-mm-dd hh:mm:ss"
        
        .Range("A4").Value = "Total Files:"
        .Range("B4").Value = lastRow - 1
        
        .Range("A5").Value = "Total Size (MB):"
        ' Sum column E (Size KB), divide by 1024
        .Range("B5").Formula = "=SUMIF(Inventory!E:E,"">0"",Inventory!E:E)/1024"
        .Range("B5").NumberFormat = "#,##0.00"
        
        .Range("A6").Value = "Unique Folders:"
        .Range("B6").Formula = "=SUMPRODUCT(1/COUNTIF(Inventory!B2:B" & lastRow & ",Inventory!B2:B" & lastRow & "))"
        
        .Range("A7").Value = "Unique Extensions:"
        .Range("B7").Formula = "=SUMPRODUCT(1/COUNTIF(Inventory!D2:D" & lastRow & ",Inventory!D2:D" & lastRow & "))"
        
        ' Style the summary block
        .Range("A3:B7").Borders(xlEdgeOutside).LineStyle = xlContinuous
        .Range("A3:A7").Font.Bold = True
        .Range("A3:A7").Interior.Color = RGB(220, 230, 241)
        
        ' --- Extension Breakdown ---
        .Range("A9").Value = "Files by Extension"
        .Range("A9").Font.Bold = True
        .Range("A9").Font.Size = 13
        
        .Range("A10").Value = "Extension"
        .Range("B10").Value = "File Count"
        .Range("C10").Value = "Total Size (KB)"
        .Range("A10:C10").Font.Bold = True
        .Range("A10:C10").Interior.Color = RGB(31, 73, 125)
        .Range("A10:C10").Font.Color = RGB(255, 255, 255)
    End With
    
    ' Build extension summary using Dictionary
    Dim extCount As Object
    Dim extSize As Object
    Set extCount = CreateObject("Scripting.Dictionary")
    Set extSize = CreateObject("Scripting.Dictionary")
    
    Dim ext As String
    Dim fileSize As Double
    
    For i = 2 To lastRow
        ext = LCase(Trim(invSheet.Cells(i, 4).Value))
        If Len(ext) = 0 Then ext = "(no extension)"
        fileSize = invSheet.Cells(i, 5).Value
        
        If extCount.Exists(ext) Then
            extCount(ext) = extCount(ext) + 1
            extSize(ext) = extSize(ext) + fileSize
        Else
            extCount(ext) = 1
            extSize(ext) = fileSize
        End If
    Next i
    
    ' Write extension breakdown to sheet
    Dim outputRow As Long
    outputRow = 11
    Dim key As Variant
    
    For Each key In extCount.Keys
        summarySheet.Cells(outputRow, 1).Value = key
        summarySheet.Cells(outputRow, 2).Value = extCount(key)
        summarySheet.Cells(outputRow, 3).Value = Round(extSize(key), 2)
        outputRow = outputRow + 1
    Next key
    
    ' Sort extension table by count descending
    Dim extRange As Range
    Set extRange = summarySheet.Range("A11").CurrentRegion
    extRange.Sort Key1:=summarySheet.Columns(2), Order1:=xlDescending, Header:=xlNo
    
    ' Apply data bars to count column
    With summarySheet.Range("B11:B" & (outputRow - 1))
        .FormatConditions.AddDatabar
        .FormatConditions(1).BarFillType = xlDataBarFillSolid
        .FormatConditions(1).MinPoint.Modify newtype:=xlConditionValueAutomaticMin
        .FormatConditions(1).MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
        .FormatConditions(1).BarColor.Color = RGB(31, 73, 125)
    End With
    
    summarySheet.Columns("A:C").AutoFit
    summarySheet.Activate
    
    MsgBox "Summary report generated on the Summary sheet.", vbInformation
End Sub

---

Flagging Files Before Renaming

One of the most important safety features in a rename engine is a dry-run mode — letting you preview which files would be renamed before anything actually happens. The "Flagged for Rename" column in the Inventory sheet serves this purpose.

Sub FlagFilesForRename()
    Dim invSheet As Worksheet
    Dim renameSheet As Worksheet
    Dim renameMap As Object
    Dim lastInvRow As Long
    Dim lastRenameRow As Long
    Dim i As Long
    Dim flagCount As Long
    Dim matchMode As String
    
    Set invSheet = ThisWorkbook.Worksheets("Inventory")
    Set renameSheet = ThisWorkbook.Worksheets("RenameMap")
    Set renameMap = CreateObject("Scripting.Dictionary")
    
    On Error Resume Next
    matchMode = ThisWorkbook.Worksheets("Control").Range("B2").Value
    On Error GoTo 0
    If Len(matchMode) = 0 Then matchMode = "Exact"
    
    ' Load rename map
    lastRenameRow = renameSheet.Cells(renameSheet.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRenameRow
        Dim cn As String, nn As String
        cn = Trim(renameSheet.Cells(i, 1).Value)
        nn = Trim(renameSheet.Cells(i, 2).Value)
        If Len(cn) > 0 And Len(nn) > 0 Then renameMap(LCase(cn)) = nn
    Next i
    
    ' Clear existing flags
    lastInvRow = invSheet.Cells(invSheet.Rows.Count, 1).End(xlUp).Row
    invSheet.Range("I2:I" & lastInvRow).ClearContents
    invSheet.Range("I2:I" & lastInvRow).Interior.ColorIndex = xlNone
    
    flagCount = 0
    Application.ScreenUpdating = False
    
    For i = 2 To lastInvRow
        Dim fileName As String
        fileName = invSheet.Cells(i, 3).Value
        
        Dim newName As String
        newName = FindRenameMatch(fileName, renameMap, matchMode)
        
        If Len(newName) > 0 Then
            invSheet.Cells(i, 9).Value = "-> " & newName
            invSheet.Cells(i, 9).Interior.Color = RGB(255, 235, 156)
            flagCount = flagCount + 1
        End If
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox flagCount & " files flagged for rename." & vbCrLf & _
           "Review column I in the Inventory sheet, then run ExecuteBatchRename.", vbInformation
End Sub

---

Hands-On Exercise

Build this complete engine and run it against a real folder on your machine. Here's a structured scenario to work through:

Scenario: You manage a folder called C:\ReportArchive\2024 containing monthly reports from multiple departments. The naming convention has drifted over the year — some files are named Sales_Report_Jan24.xlsx, others are Jan_2024_Sales.xlsx, and a few rogue ones are sales report january 2024 FINAL.xlsx.

Step 1 — Initial Scan
Run ScanDirectory against C:\ReportArchive\2024. Review the Inventory sheet. How many files? What's the size distribution? Are there any files marked as Hidden or ReadOnly?

Step 2 — Build Your Rename Map
In the RenameMap sheet, add entries to standardize to the format DEPT_YYYY_MM_Report.xlsx. Set the match mode in your Control sheet cell B2 to Contains. For example:

• Current Name: jan_2024_sales → New Name: Sales_2024_01_Report.xlsx
• Current Name: sales report january → New Name: Sales_2024_01_Report.xlsx

Step 3 — Dry Run
Run FlagFilesForRename and review column I. Does every flagged row show the correct new name? Are any files incorrectly matched?

Step 4 — Execute
Once you're satisfied with the flags, run ExecuteBatchRename. Check the AuditLog sheet — every operation should show "Success" in green.

Step 5 — Generate Report
Run GenerateInventoryReport and review the Summary sheet. Use the extension breakdown as evidence that all .xlsx files were processed.

Stretch goal: Modify TraverseFolder to also capture folder-level metadata (folder name, number of direct children, total size) into a second sheet called FolderInventory. You'll need to loop through folder.SubFolders and write a parallel WriteFolderToInventory procedure.

---

Common Mistakes & Troubleshooting

"Path not found" errors on network drives
UNC paths like \\ServerName\Share\Folder work fine with FSO, but mapped drive letters (like Z:\) can be unreliable when macros run under different user contexts. Always prefer UNC paths for network operations, and validate the path with fso.FolderExists() before proceeding.

The scan runs but finds 0 files
This almost always means the target folder exists but is empty, or the folder path has a trailing backslash that FSO doesn't expect. fso.GetFolder("C:\Reports\") works fine, but trim trailing slashes from user input anyway as a habit: targetFolder = TrimTrailingSlash(targetFolder).

Rename fails silently
If fso.MoveFile fails and you see it logged in AuditLog as "Failed" but with no useful error description, the most common causes are: (1) a file with the new name already exists in that folder — FSO won't overwrite, (2) the file is open in another application, or (3) you don't have write permissions. Add a pre-check: If fso.FileExists(newPath) Then log "Target name already exists" and skip.

Performance degrades badly on deep directory trees
If you're scanning a path with hundreds of subfolders and 50,000+ files, writing each file to the sheet one row at a time creates significant overhead from individual cell writes. Refactor WriteFileToInventory to build a 2D array in memory and dump the entire array to the sheet in a single operation at the end. This is a classic VBA performance pattern — writing a 50,000-row array to a sheet in one shot takes about the same time as writing 100 rows cell by cell.

' Instead of writing row by row, accumulate in array
' Then at the end of TraverseFolder:
invSheet.Range("A2").Resize(UBound(dataArray, 1), UBound(dataArray, 2)).Value = dataArray

The RegExp pattern renames more files than expected
Regex matching is powerful but greedy. The pattern report will match report, monthly_report, report_final, and reporting. Always test your regex patterns against a sample of your inventory before running the live rename. Use FlagFilesForRename as your safety net — review every flag before executing.

---

Summary & Next Steps

You've built a complete, production-ready file system automation engine inside Excel. Let's recap what it can do:

• Recursively traverse any directory tree, including network paths, handling locked files and protected folders gracefully
• Extract rich metadata including file size, dates, attributes, and optionally owner and document properties
• Generate structured inventory reports with extension breakdowns, data bars, and formatted summary statistics
• Execute batch renames from an Excel mapping table using exact, contains, or regex matching
• Log every operation to an audit trail with timestamps, original paths, new paths, and success/failure status

This engine is a genuine productivity tool. Data teams use variations of exactly this pattern to audit shared drives before migrations, enforce naming conventions across project folders, and generate compliance inventories of sensitive file locations.

Where to go next:

• Integrate this with the file and email operations patterns in VBA to automatically email the inventory report after each scan
• Add a UserForm interface so users can configure the scan path, match mode, and output options without touching the spreadsheet at all
• Explore multi-workbook consolidation — once you can traverse directories and find files, opening and processing them is the natural next step
• Consider wrapping this engine into an Excel Add-In so it's available in any workbook across your organization without needing to copy the module each time

The file system is one of the most underutilized surfaces for Excel VBA automation. Most practitioners know VBA can manipulate spreadsheets — far fewer realize it can serve as a full-featured file management platform. Now you're one of the practitioners who knows.