Excel VBA code to copy and rename a number of files, based on the data on an Excel sheet.

bulk_file_renamer.vb

Sub batch_rename()
    On Error GoTo errHndl
   
    Dim fso As New FileSystemObject
    Dim fld As Folder
    Dim sourcePath As String, destPath As String
    Dim sourceFile As String, destFile As String, sourceExtension As String
    Dim rng As Range, cell As Range, row As Range
   
    sourcePath = "\path to old files\"
    destPath = "\path to new files\"
    sourceFile = ""
    destFile = ""
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set rng = ActiveSheet.Range("A2", "B10")
 
    For Each row In rng.Rows
        sourceExtension = Split(Trim(row.Cells(, 2)), ".")(1)
        sourceFile = sourcePath + Trim(row.Cells(, 2))
        destFile = destPath + Trim(row.Cells(, 1)) + "." + sourceExtension
        fso.CopyFile sourceFile, destFile, False
    Next row
   
    MsgBox "Yay! Operation was successful.", vbOKOnly + vbInformation, "Done"
    Exit Sub
 
errHndl:
    MsgBox "Error happened while working on: " + vbCrLf + _
        sourceFile + vbCrLf + vbCrLf + "Error " + _
        Str(Err.Number) + ": " + Err.Description, vbCritical + vbOKOnly, "Error"
 
End Sub

can you give me blog to describe this code? how to use?
my whatsapp: 085207770631

Hello ,

should i replace the sourcePath = "\path to old files" by the path that i have ? because when i write "c:" it doesn t work and a message error appeared : error happened while working on .

Please , what should i do next ?

Hi,

I would recommend using & operator instead of + operator and declare

Dim fsa as Object to avoid any errors.

i have modified your code a bit to create multiple copies of a file and rename it differently. Hope it helps all in need

Sub batch_rename()
On Error GoTo errHndl

Dim fso As Object
'Dim fld As Folder
Dim sourcePath As String, destPath As String
Dim sourceFile As String, destFile As String, sourceExtension As String
Dim rng As Range, cell As Range, row As Range

sourcePath = "path"
destPath = "path"
sourceFile = ""
destFile = ""
Set fso = CreateObject("Scripting.FileSystemObject")
'Set rng = ActiveSheet.Range("A2", "B10")

For i = 2 To 100
    sourceExtension = ".xlsx"
    a = "Vol " & i
    sourceFile = sourcePath & "Vol 1.xlsx"
    destFile = destPath & a & sourceExtension
    fso.CopyFile sourceFile, destFile, False
Next i

MsgBox "Yay! Operation was successful.", vbOKOnly + vbInformation, "Done"
Exit Sub

errHndl:
MsgBox "Error happened while working on: " + vbCrLf + _
sourceFile + vbCrLf + vbCrLf + "Error " + _
Str(Err.Number) + ": " + Err.Description, vbCritical + vbOKOnly, "Error"

End Sub

hi
i have 1000 list of pdf file name in Cell A with existing file path and 1000 new name along with new file file path in cell B now i need to copy or move those files from existing path to new location someone please help me with this.
exp existing path= C:\Users\Dinesh Kumar MP\Desktop\Dinesh\Dinesh.pdf
New path = C:\Users\Dinesh Kumar MP\Desktop\Kumar\Kumar.pdf