File renaming applications are great if you need to rename a lot of files. They can be even better if you can use Excel’s built-in functions such as TRIM, SUBSTITUTE, FIND, LEFT, and RIGHT in order to clean up and generate your new file names.
Excel VBA File Renamer for Windows is my take on the idea and can be downloaded here:
dailyexcel.net Excel VBA File Renamer for Windows
dailyexcel.net Excel VBA File Renamer for Windows enables you to rename multiple files, with your old file name defined in the cell B11, B12, B13, etc., and your new file name defined in the cell C11, C12, C13, etc.:
You can define your folder address in cell B1:
If you click refresh, the first n files as defined in cell B3 will be loaded into the Excel file. In column A, links to files in your folder are loaded. In column B, file names are loaded. In column C, you can generate new names using built-in Excel functions:
Optionally, you can define a filter in cell B2 in order to load only certain filenames into the worksheet by using the refresh button:
As noted, in cell B3 you can define the first n number of files to be loaded from the folder.
In cell B5, a formula calculates the number of files loaded.
In cell B6, a formula calculates the number of files that will be renamed by checking if there is an old file name in a row, if there is a new file name in a row, and if they are different.
In cell B7, a formula checks if the file extensions differ. It will not stop you from renaming; this is a warning field.
In the cell B8, a formula checks if your new filenames contain special characters < > / \ | ” ? * that can’t be used as part of the filename in Windows. If this calculation returns an error, you can’t start the renaming process.
As visible in the formula bar, we’ve generated new filenames using the RIGHT, LEFT, and FIND functions here:
You can start the renaming process by clicking on the rename button:
The following issues will stop rename from running:
- there is a filename with a character that can’t be part of the filename Windows
- old filename doesn’t exist, or new filename already exists
- the file is in use, i.e., open in Excel, Word, Adobe Acrobat, etc.
When rename runs successfully, refresh will also run after it.
In our example, this will result in several errors in the worksheet; there is an error in the cells C11, C12, C13, etc. because old names are now empty, and old names are now empty because files that meet the filtering criteria laid out in cell B2 no longer exist:
We can delete our filtering criteria and new names if we don’t intend to use the formulas in the cells C11, C12, C13, etc. again:
If we remove our filtering criteria from cell B2 and run refresh again, we can see our files with their new names:
The following VBA code was used in this workbook:
Sub refresh()
‘stop Excel from recalculating until all the data is available
Application.Calculation = xlManualDim RetrievedFolderPath As String
RetrievedFolderPath = Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B1”) & “\” & Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B2”)
Dim RetrievedFilename As String
Dim r As Integer
Dim k As Integer
Dim z As Integer
z = Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B3”)
Dim u As Integer
Application.ThisWorkbook.Worksheets(“Sheet1”).UsedRange
u = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.count).Row‘load files into array
Dim FolderListArray() As String
ReDim FolderListArray(z)‘array to strings
RetrievedFilename = Dir(RetrievedFolderPath)
Do While RetrievedFilename <> “” And r < z
FolderListArray(r) = RetrievedFilename
RetrievedFilename = Dir
r = r + 1
Loop‘write filenames as strings into Sheet1, write hyperlinks if filenames were written, clean area from last returned string to the last row with data
Do While k <= u
If k <= z Then
Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(11 + k, 2) = FolderListArray(k)
If Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(11 + k, 2) <> “” Then
Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(11 + k, 1) = “=HYPERLINK(“”” & Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B1”) & “\” & Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(11 + k, 2) & “””,””link””)”
Else
Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(11 + k, 1) = “”
End If
Else
Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(11 + k, 2) = “”
Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(11 + k, 1) = “”
End Ifk = k + 1
Loop‘Excel can now calculate
Application.Calculation = xlAutomaticEnd Sub
Sub rename()
‘confirm renames yes or no, exit if there are no files to rename
If Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B6”) > 0 And Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B7”) > 0 Then
If MsgBox(“Are you sure you want to rename ” & Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B6″) & ” file(s)?” & vbNewLine & Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B7″) & ” file extension(s) will be changed.”, vbYesNo) = vbNo Then Exit Sub
ElseIf Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B6”) > 0 And Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B7”) = 0 Then
If MsgBox(“Are you sure you want to rename ” & Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B6″) & ” file(s)?”, vbYesNo) = vbNo Then Exit Sub
Else
MsgBox (“There are no files to rename.”)
Exit Sub
End IfDim FolderPath As String
FolderPath = Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B1”) & “\”Dim FileCheckObject
Set FileCheckObject = CreateObject(“Scripting.FileSystemObject”)Dim y As Integer
y = Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B5”)
Dim x As Integer
Dim t As Integer
t = 0‘don’t run if there is filename with a character that can’t be part of filename in Windows
If Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B8”) > 0 Then
MsgBox (Application.ThisWorkbook.Worksheets(“Sheet1”).Range(“B8″) & ” file name(s) contain special charachters.” & vbNewLine & “Resolve the issue and run rename again.”)
Exit Sub
End If‘don’t run if old filename don’t exist, or new filename already exists
For x = 1 To y
If Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2) <> “” And Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 3) <> “” And Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2) <> Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 3) And Not (FileCheckObject.FileExists(FolderPath + Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2))) Then
MsgBox (“Some old names don’t exist (anymore).” & vbNewLine & “Resolve the issue and run rename again.”)
Exit Sub
ElseIf Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2) <> “” And Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 3) <> “” And Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2) <> Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 3) And FileCheckObject.FileExists(FolderPath + Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 3)) Then
MsgBox (“Some new names already exist.” & vbNewLine & “Resolve the issue and run rename again.”)
Exit Sub
End If
Next x‘check if files are available for rename by temporarily renaming them
For x = 1 To y
If Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2) <> “” And Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 3) <> “” And Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2) <> Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 3) Then
On Error GoTo endRename
Name FolderPath + Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2) As FolderPath + “check_” + Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2)
Name FolderPath + “check_” + Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2) As FolderPath + Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2)
GoTo skipEnd
endRename:
MsgBox (“Some old names are already in use (open).” & vbNewLine & “Resolve the issue and run rename again.”)
Exit Sub
skipEnd:
End If
Next x‘run for loaded files, if old name isn’t empty and new name isn’t empty and they differ
For x = 1 To y
If Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2) <> “” And Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 3) <> “” And Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2) <> Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 3) Then
Name FolderPath + Application.ThisWorkbook.Worksheets(“Sheet1”).Cells(10 + x, 2) As FolderPath + Application.ThisWorkbook.Worksheets(“Sheet1″).Cells(10 + x, 3)
t = t + 1
End If
Next x‘results
MsgBox t & ” files renamed, refresh pending”, vbOKOnly‘run sub refresh ()
Call refreshEnd Sub
Formulas used in the cells C5, C6, C7, and C8, are, respectively:
=COUNTA(INDIRECT(“$B11:$B”&$B$3+10)
{=SUM(
NOT(INDIRECT(“$B11:$B”&$B$3+10)=””)
*NOT(INDIRECT(“$C11:$C”&$B$3+10)=””)
*NOT(INDIRECT(“$B11:$B”&$B$3+10)=INDIRECT(“$C11:$C”&$B$3+10)))}
{=SUM(
IFERROR(
RIGHT(SUBSTITUTE(INDIRECT(“$B11:$B”&$B$5+10);”.”;”:”;LEN(SUBSTITUTE(INDIRECT(“$B11:$B”&$B$5+10);”.”;”..”))-LEN(INDIRECT(“$B11:$B”&$B$5+10)));LEN(SUBSTITUTE(INDIRECT(“$B11:$B”&$B$5+10);”.”;”:”;LEN(SUBSTITUTE(INDIRECT(“$B11:$B”&$B$5+10);”.”;”..”))-LEN(INDIRECT(“$B11:$B”&$B$5+10))))-FIND(“:”;SUBSTITUTE(INDIRECT(“$B11:$B”&$B$5+10);”.”;”:”;LEN(SUBSTITUTE(INDIRECT(“$B11:$B”&$B$5+10);”.”;”..”))-LEN(INDIRECT(“$B11:$B”&$B$5+10)))))
<>RIGHT(SUBSTITUTE(INDIRECT(“$C11:$C”&$B$5+10);”.”;”:”;LEN(SUBSTITUTE(INDIRECT(“$C11:$C”&$B$5+10);”.”;”..”))-LEN(INDIRECT(“$C11:$C”&$B$5+10)));LEN(SUBSTITUTE(INDIRECT(“$C11:$C”&$B$5+10);”.”;”:”;LEN(SUBSTITUTE(INDIRECT(“$C11:$C”&$B$5+10);”.”;”..”))-LEN(INDIRECT(“$C11:$C”&$B$5+10))))-FIND(“:”;SUBSTITUTE(INDIRECT(“$C11:$C”&$B$5+10);”.”;”:”;LEN(SUBSTITUTE(INDIRECT(“$C11:$C”&$B$5+10);”.”;”..”))-LEN(INDIRECT(“$C11:$C”&$B$5+10)))));0)
*1)}
{=SUM(
IF((
IFERROR(FIND(“~”&CHAR(42);INDIRECT(“$C11:$C”&$B$5+10));0)
+IFERROR(FIND(“~”&CHAR(63);INDIRECT(“$C11:$C”&$B$5+10));0)
+IFERROR(FIND(CHAR(47);INDIRECT(“$C11:$C”&$B$5+10));0)
+IFERROR(FIND(CHAR(92);INDIRECT(“$C11:$C”&$B$5+10));0)
+IFERROR(FIND(CHAR(58);INDIRECT(“$C11:$C”&$B$5+10));0)
+IFERROR(FIND(CHAR(62);INDIRECT(“$C11:$C”&$B$5+10));0)
+IFERROR(FIND(CHAR(60);INDIRECT(“$C11:$C”&$B$5+10));0)
+IFERROR(FIND(CHAR(124);INDIRECT(“$C11:$C”&$B$5+10));0)
)=0;0;1))}
Legacy array formulas shown here were used purely due to technical limitations imposed by WordPress, i.e., the xlsm file format is not supported. Originally, those formulas were written as:
=COUNTA(INDIRECT(“$B11:$B”&$B$3+10))
=LET(
old_name;INDIRECT(“$B11:$B”&$B$3+10);
new_name;INDIRECT(“$C11:$C”&$B$3+10);
sequence;SEQUENCE($B$3;1;1;0);
IFERROR(SUM(FILTER(sequence;NOT(old_name=””)*NOT(new_name=””)*NOT(old_name=new_name)));0))
=LET(
old_name;INDIRECT(“$B11:$B”&$B$3+10);
new_name;INDIRECT(“$C11:$C”&$B$3+10);
count_in_old_name;LEN(SUBSTITUTE(old_name;”.”;”..”))-LEN(old_name);
count_in_new_name;LEN(SUBSTITUTE(new_name;”.”;”..”))-LEN(new_name);
replaced_in_old_name;SUBSTITUTE(old_name;”.”;”:”;count_in_old_name);
replaced_in_new_name;SUBSTITUTE(new_name;”.”;”:”;count_in_new_name);
extension_old_name;RIGHT(replaced_in_old_name;LEN(replaced_in_old_name)-FIND(“:”;replaced_in_old_name));
extension_new_name;RIGHT(replaced_in_new_name;LEN(replaced_in_new_name)-FIND(“:”;replaced_in_new_name));
compare_extension;IF(extension_old_name=extension_new_name;0;1);
IFERROR(SUM(FILTER(compare_extension;NOT(ISERROR(compare_extension))));0)
)
=LET(
new_name;INDIRECT(“$C11:$C”&$B$3+10);
SUM(IF((IFERROR(SEARCH(“~”&UNICHAR(42);new_name);0)+IFERROR(SEARCH(“~”&UNICHAR(63);new_name);0)+IFERROR(SEARCH(UNICHAR(47);new_name);0)+IFERROR(SEARCH(UNICHAR(92);new_name);0)+IFERROR(SEARCH(UNICHAR(58);new_name);0)+IFERROR(SEARCH(UNICHAR(62);new_name);0)+IFERROR(SEARCH(UNICHAR(60);new_name);0)+IFERROR(SEARCH(UNICHAR(124);new_name);0))=0;0;1))
)