theme-sticky-logo-alt
theme-logo-alt

Better File and Folder Management – With Excel

Files selection and management
0 Comments

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.

Previous
Next

0 Comments

Leave a Reply

15 49.0138 8.38624 1 1 8000 1 https://digitalbbq.au 300 0