Last active
July 10, 2019 13:03
-
-
Save shabdar/4582250 to your computer and use it in GitHub Desktop.
Excel VBA code to copy and rename a number of files, based on the data on an Excel sheet.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
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