Using Excel VBA to rename files or folders

Renaming files and folders can be a troublesome thing at times especially when you got 100s of folders or files to renamed based on your custom criteria. Below is a step-by-step guide to do renaming of files or folders using MS Excel.

1. Press Alt + F11
2. Insert a module in project explorer
3. Paste following code into code window
4. Return to Microsoft Excel

Sub FileNametoExcel()
Dim fnam As Variant
' fnam is an array of files returned from GetOpenFileName
' note that fnam is of type boolean if no array is returned.
' That is, if the user clicks on cancel in the file open dialog box, fnam is set to FALSE
Dim b As Integer 'counter for filname array
Dim b1 As Integer 'counter for finding \ in filename
Dim c As Integer 'extention marker
' format header
Range("A1").Select
ActiveCell.FormulaR1C1 = "Path and Filenames that had been selected to Rename"
Range("A1").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
End With
Columns("A:A").EntireColumn.AutoFit
Range("B1").Select
ActiveCell.FormulaR1C1 = "Input New Filenames Below"
Range("B1").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
End With
Columns("B:B").EntireColumn.AutoFit
' first open a blank sheet and go to top left ActiveWorkbook.Worksheets.Add
fnam = Application.GetOpenFilename("all files (.), .", 1, _
"Select Files to Fill Range", "Get Data", True)
If TypeName(fnam) = "Boolean" And Not (IsArray(fnam)) Then Exit Sub
'if user hits cancel, then end
For b = 1 To UBound(fnam)
' print out the filename (with path) into first column of new sheet
ActiveSheet.Cells(b + 1, 1) = fnam(b)
Next
End Sub

---

Here is 2nd subroutine which RENAMES the files:

Sub RenameFile()
Dim z As String
Dim s As String
Dim V As Integer
Dim TotalRow As Integer
TotalRow = ActiveSheet.UsedRange.Rows.Count
For V = 1 To TotalRow
' Get value of each row in columns 1 start at row 2
z = Cells(V + 1, 1).Value
' Get value of each row in columns 2 start at row 2
s = Cells(V + 1, 2).Value
Dim sOldPathName As String
sOldPathName = z
On Error Resume Next
Name sOldPathName As s
Next V
MsgBox "Congratulations! You have successfully renamed all the files"
End Sub

---

Below code is for renaming folders

Sub Folder_Name_To_Excel()
Dim FileSystem As Object, Folder As Object, SubFolder As Object
Dim InitialPath As String, b As Integer
b = 1
InitialPath = "C:\Users\xxxx\Desktop\Syed"
Set FileSystem = CreateObject("Scripting.filesystemobject")
Set Folder = FileSystem.GetFolder(InitialPath)
Range("A1").Select
For Each SubFolder In Folder.subfolders
ActiveSheet.Cells(b + 1, 1) = SubFolder
b = b + 1
Next SubFolder
End Sub

Sub RenameFolders()
Dim z As String
Dim s As String
Dim V As Integer
Dim TotalRow As Integer
TotalRow = ActiveSheet.UsedRange.Rows.count
For V = 1 To TotalRow
z = Cells(V + 1, 1).Value
s = Cells(V + 1, 2).Value
Dim sOldPathName As String
sOldPathName = z
On Error Resume Next
Name sOldPathName As s
Next V
MsgBox "Congratulations! You have successfully renamed all the Folders"
End Sub