An old colleague shared this fantastic Excel file with me when I needed to bulk rename files. Our IT policies didn’t allow us to install useful tools such as Better File Rename. The Excel file contains VBA macros that list folder contents and rename files, and it has now become my go-to method to bulk rename files as you can use all the smarts of Excel formulas to generate file names.
The tool has even come to save me countless hours in a complex series of events where, due to a misunderstanding of an intermediary between our team and the client, drawing revisions and titles became out of sequence between what we had on record as our latest information versus what the client had received. In some instances, the client had unknowingly missed two revisions of some of our drawings.
Using what I had on record, collecting what the client had on record, and using Bluebeam to extract information from the PDFs across the project, I was able to quickly identify the discrepancies in drawings, identify drawings where revisions had to be removed and rename the deliverables to suit, including the revision as a suffix to the file name.
While I certainly can’t take credit for the original Excel file, I recently had to make a series of changes for various reasons.
x64 Compatibility
The first modification came when I wanted to use the Excel file on an x64 installation of Office. It just didn’t work. Not to be defeated, after some research I discovered that the issue was related to the 32-bit API declarations in the code, which won’t work on a 64-bit system. I had to set about modifying the declarations to make them compatible with both 32-bit and 64-bit systems.
Code (click to expand)
#If VBA7 Then
Public Type BROWSEINFO
hOwner As LongPtr
pidlRoot As LongPtr
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As LongPtr
lParam As Long
iImage As Long
End Type
Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As LongPtr, ByVal pszPath As String) As Long
Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (ByRef lpBrowseInfo As BROWSEINFO) As LongPtr
#Else
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (ByRef lpBrowseInfo As BROWSEINFO) As Long
#End If
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim r As Long
#If VBA7 Then
Dim x As LongPtr
#Else
Dim x As Long
#End If
Dim pos As Integer
' Rest of your code remains the same
End FunctionCode language: PHP (php)The #If VBA7 Then directive checks for VBA 7.0 or later, which includes all 64-bit versions of Office. If so VBA 7.0 is detected, it uses the LongPtr data type and the PtrSafe keyword, which is required for 64-bit compatibility. Using this solution, if the file is opened on a system that is using an older version of VBA, it falls back to the original 32-bit declarations.
Adding Folder Renaming Functionality
I was then approached with a scenario that involved auditing a series of folders, which included tasks like renaming and relocating these folders. I thought this would be a perfect use of the Excel tool; it’s just it didn’t have the functionality to work with folders.
Looking into VBA FileSystemObject methods, I built in the functionality to perform the same work on folders as it does with files. Not being particularly adept at VBA, I stumbled when I created a “Loop without do” error, but with review and adjustment of the loop structures in the code, the fix ended up being straightforward enough, but obviously critical to have working correctly when dealing with critical business documents.
Fixing the Folder Dialog Browser Button
Pleased with the new functionality for renaming and relocating folders, I passed the tool to a user for testing. The very first thing she did when using the Excel tool was to click the browse button, which, of course, makes complete sense to do so.
The thing is, it turns out it didn’t work. You could select the folder, but then it would cause Excel to crash and close without warning. Whenever I used the tool, I cut and paste the folder location I wanted to work with as text to the cell where it was required instead of clicking the button.
It turned out to be another issue with 32 and 64bit compatibility as the original code included the functions SHBrowseFolder and SHGetPathFromIDList, which I could have resolved by going down the path of declaring 32 and 64bit compatible variables, but instead, I decided the best action would be to use Excel’s built-in folder picker dialogue, which is generally more stable and should be compatible with any version of Excel.
Code (click to expand)
Function GetDirectory(Optional Msg As String) As String
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
If Msg <> "" Then .Title = Msg ' Set the title of the dialog box if provided
If .Show = -1 Then ' If the user makes a selection
GetDirectory = .SelectedItems(1) ' Return the selected path
Else
GetDirectory = "" ' If the user cancels, return an empty string
End If
End With
End Function
Code language: PHP (php)Auditing Folders Based on Last Modified Dates of the Contained Files
The final development request I received was to implement a feature in the tool that calculates the time in months since the last modification of a folder’s contents. This would assist in the decision-making process of determining when a folder could be archived.
To tackle this request, it required the creation of an AuditFolders subroutine that goes into each folder and collects the timestamps from each file, and returning the date of the newest file. I achieved this by modifying the ListFolders subroutine to iterate through each file in the folder, get the latest modified date of each file and the name of that file, then report the most recent date to a column in Excel.
Code (click to expand)
Sub AuditFolders()
'Create a list of folders and find the newest file's date in each
'Check for errors
ErrorMsg = "Problem creating list - check path."
If Range("Path").Value = "" Then GoTo ErrorHandler
'If no error then main code
Application.ScreenUpdating = False
DirName = Range("Path").Value
If Right(DirName, 1) <> "\" Then DirName = DirName & "\"
'Clear area for list
Range("Filelist").Offset(1, 0).Select
RowCounter = 0
Range("B" & ActiveCell.Row & ":G65536").ClearContents
Range("B" & ActiveCell.Row & ":G65536").Interior.ColorIndex = 2
' Loop to insert folder names and details
NextFile = Dir(DirName & "*.*", vbDirectory)
Do While NextFile <> ""
If (GetAttr(DirName & NextFile) And vbDirectory) = vbDirectory Then
If NextFile <> "." And NextFile <> ".." Then
' Populate the list with folder details
ActiveCell.Offset(RowCounter, 0).Value = NextFile
'ActiveCell.Offset(RowCounter, 5).Value = NextFile ' Copy folder name to column G
' Find the newest file in the folder
Dim NewestFileInfo As FileInfo
NewestFileInfo = GetNewestFileInfo(DirName & NextFile)
' Add the newest file's date to column D and name to the next column
If NewestFileInfo.DateModified <> 0 Then
ActiveCell.Offset(RowCounter, 2).Value = NewestFileInfo.DateModified
ActiveCell.Offset(RowCounter, 3).Value = NewestFileInfo.FileName
' Calculate the age in months and add to the next column
Dim FileAgeMonths As Integer
FileAgeMonths = DateDiff("m", NewestFileInfo.DateModified, Now)
ActiveCell.Offset(RowCounter, 4).Value = FileAgeMonths
End If
RowCounter = RowCounter + 1
End If
End If
NextFile = Dir() ' Get next folder
Loop
If ActiveCell.Offset(1, 0).Value = "" Then [A1].Select: Exit Sub
'Sort alphabetically
Selection.CurrentRegion.Select
Selection.Sort key1:=Range(ActiveCell.Address), order1:=xlAscending, Header:=xlYes
[A1].Select
Exit Sub
ErrorHandler:
MsgBox ErrorMsg, vbInformation, "List folders"
[A1].Select
End Sub
Sub AuditFiles()
'Create a list of all files in folders
'Check for errors
ErrorMsg = "Problem creating list - check path."
If Range("Path").Value = "" Then GoTo ErrorHandler
'If no error then main code
Application.ScreenUpdating = False
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
DirName = Range("Path").Value
If Right(DirName, 1) <> "\" Then DirName = DirName & "\"
'Clear area for list
Range("Filelist").Offset(1, 0).Select
RowCounter = 0
Range("B" & ActiveCell.Row & ":F65536").ClearContents
Range("B" & ActiveCell.Row & ":F65536").Interior.ColorIndex = 2
' Get the root folder
Dim rootFolder As Object
Set rootFolder = fso.GetFolder(DirName)
' Loop through each subfolder
Dim subFolder As Object
For Each subFolder In rootFolder.SubFolders
' Loop through each file in the subfolder
Dim file As Object
For Each file In subFolder.Files
' Populate the list with file details
ActiveCell.Offset(RowCounter, 0).Value = subFolder.Name
ActiveCell.Offset(RowCounter, 3).Value = file.Name
ActiveCell.Offset(RowCounter, 2).Value = file.DateLastModified
' Calculate the age in months and add to the next column
Dim FileAgeMonths As Integer
FileAgeMonths = DateDiff("m", file.DateLastModified, Now)
ActiveCell.Offset(RowCounter, 4).Value = FileAgeMonths
RowCounter = RowCounter + 1
Next file
Next subFolder
If ActiveCell.Offset(1, 0).Value = "" Then [A1].Select: Exit Sub
'Sort alphabetically
Selection.CurrentRegion.Select
Selection.Sort key1:=Range(ActiveCell.Address), order1:=xlAscending, Header:=xlYes
[A1].Select
Exit Sub
ErrorHandler:
MsgBox ErrorMsg, vbInformation, "List files"
[A1].Select
End Sub
Function GetNewestFileDate(FolderPath As String) As Date
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim folder As Object
Set folder = fso.GetFolder(FolderPath)
Dim file As Object
Dim mostRecentDate As Date
mostRecentDate = 0 ' Initialize to a zero date
For Each file In folder.Files
If file.DateLastModified > mostRecentDate Then
mostRecentDate = file.DateLastModified
End If
Next file
GetNewestFileDate = mostRecentDate
End Function
Function GetNewestFileInfo(FolderPath As String) As FileInfo
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim folder As Object
Set folder = fso.GetFolder(FolderPath)
Dim file As Object
Dim mostRecentInfo As FileInfo
mostRecentInfo.DateModified = 0 ' Initialize to a zero date
For Each file In folder.Files
If file.DateLastModified > mostRecentInfo.DateModified Then
mostRecentInfo.DateModified = file.DateLastModified
mostRecentInfo.FileName = file.Name
End If
Next file
GetNewestFileInfo = mostRecentInfo
End FunctionCode language: PHP (php)As you can see from the code, there was a little more to it than adding a single subroutine, but the result is worth it, quickly providing a visual representation of the age of folders based on their most recently modified file, with the below example from the Autodesk installation folder on my machine:
Potential Future Development
While I don’t intend to develop the tool any further, as it fits my current needs quite nicely, there is ample opportunity to build in more functionality to elevate the tool’s utility for a wider range of applications, such as:
- Advanced filtering options to locate files/folders by various criteria
- A duplicate file finder to manage redundancy
- A feature to calculate and display file/folder sizes for efficient disk space management
- The ability to export lists and details to CSV or PDF for record-keeping
- Integrating customizable reports for user-defined data analysis
I often tell people that a tool’s potential is limited only by their imagination and skill. While some might see this Excel VBA tool as using the right tool for the wrong job, I’d argue for its versatility in managing complex data and manipulating it with ease. This tool offers unmatched flexibility in file renaming tasks for anyone skilled in Excel formulas.
I’m sharing both the code and the complete Excel file on GitHub, and I’m keen to see the potential for collaborative enhancements that the tool might receive from the community. If you find new ways to enhance or utilise this tool, or have insights to share, I’d love to hear about it.
No Comments