Batch File Renaming with VBA

Below is an example of how Microsoft Excel files can be renamed in a batch, based on the contents of a particular cell within each file.

Firstly, the file path is set and a check is carried out to make sure that the path exists. All the Excel files with a ‘.xlsx’ file extension are then processed one by one. The value from the chosen cell for the new file name is verified and, if a value exists, it is used to rename the file if the new file name is different from the old one. Finally, feedback is given as to the number of files renamed.

' File path.
Dim path As String
path = "C:\Demo\"

' Check if the file path exists.
If Dir(path, vbDirectory) <> "" Then

    ' File.
    Dim file As String
    file = Dir(path & "*.xlsx")
    
    ' Workbook.
    Dim wb As Workbook
    
    ' Cell containing new file name.
    Dim cellForFileName As String
    cellForFileName = "A1"
    
    ' New file name.
    Dim newFileName As String
    newFileName = ""
    
    ' Renamed file count.
    Dim filesRenamed As Integer
    filesRenamed = 0
    
    ' Speed up macro by disabling some Excel features.
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' Process the files at the path.
    Do While file <> ""
    
        ' Assign the workbook to a variable.
        Set wb = Workbooks.Open(Filename:=path & file)
        
        ' Check if there is a value in the cell for the new file name.
        If wb.Worksheets(1).Range(cellForFileName).Value <> "" Then
        
            ' Assign cell value for new file name to a variable.
            newFileName = wb.Worksheets(1).Range(cellForFileName).Value
            
            ' Close the workbook without saving.
            wb.Close SaveChanges:=False
            
            ' Rename the file if the new and old names are not the same.
            If path & file <> path & newFileName & ".xlsx" Then
            
                ' Rename file.
                Name path & file As path & newFileName & ".xlsx"
                
                ' Increment the file count.
                filesRenamed = filesRenamed + 1
            
            End If
            
        Else
        
            ' Close the workbook without saving.
            wb.Close SaveChanges:=False
            
        
        End If
        
        ' Next file.
        file = Dir()
    Loop
    
    ' Re-enable previously disabled Excel features.
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    ' Feedback on renamed files.
    If filesRenamed = 0 Then
    
        ' Message stating no files were renamed.
        MsgBox ("No files were renamed.")
    
    Else
    
        ' Feedback stating number of files renamed.
        If filesRenamed = 1 Then
        
            MsgBox (filesRenamed & " file renamed successfully.")
        
        Else
        
            MsgBox (filesRenamed & " files renamed successfully.")
        
        End If
    
    End If

Else

    ' Message stating file path does not exist.
    MsgBox ("File path does not exist.")

End If