• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Rename multiple files in a folder with a macro

Check this...

Code:
Option Explicit
Sub rename_5()
Dim NewName As String, mydir As String, objFile As Object
Dim Last_name As String, id As String

mydir = Application.ThisWorkbook.Path
id = Range("e2").Value

With CreateObject("Scripting.FileSystemObject")
    For Each objFile In .GetFolder(mydir).Files
           
            Last_name = Mid(objFile.Name, _
                    InStrRev(objFile.Name, "_") + 1, InStrRev(objFile.Name, ".") - _
                    InStrRev(objFile.Name, "_") - 1)
                   
            NewName = Replace(objFile.Name, Last_name, Last_name & "_" & Format(Date, "YYYYMMDD"))
     
        NewName = Replace(NewName, id, "")
        NewName = id & "_" & NewName
       
        On Error Resume Next
        Name objFile As Replace(objFile, objFile.Name, NewName)
        On Error GoTo 0
N:    Next
End With

MsgBox "Done"
End Sub
 
Check this...

Code:
Option Explicit
Sub rename_5()
Dim NewName As String, mydir As String, objFile As Object
Dim Last_name As String, id As String

mydir = Application.ThisWorkbook.Path
id = Range("e2").Value

With CreateObject("Scripting.FileSystemObject")
    For Each objFile In .GetFolder(mydir).Files
         
            Last_name = Mid(objFile.Name, _
                    InStrRev(objFile.Name, "_") + 1, InStrRev(objFile.Name, ".") - _
                    InStrRev(objFile.Name, "_") - 1)
                 
            NewName = Replace(objFile.Name, Last_name, Last_name & "_" & Format(Date, "YYYYMMDD"))
   
        NewName = Replace(NewName, id, "")
        NewName = id & "_" & NewName
     
        On Error Resume Next
        Name objFile As Replace(objFile, objFile.Name, NewName)
        On Error GoTo 0
N:    Next
End With

MsgBox "Done"
End Sub

It is working without errors, but once again does not work on some occasions,
No worries I really appreciate everything! Thanks again :)
 
It is working without errors, but once again does not work on some occasions,
No worries I really appreciate everything! Thanks again :)
Hi,

May I know "some occasions" when it failed to deliver the output.
Pls let me know the before and after name in text format not pic.
 
for exemple :
i had " 5455454564_BSC393588_BCF14.xls"

After inserting id =15893 the result was

" 15893_5455454564_BSC393588_BCF14_20150522.xls"

and i want "15893_BSC393588_BCF14_20150522.xls" ,

ButI solved it, Once again many thanksfor your help.
 
Hi Deepak / Rui,

Great post and I can see how useful this can be but would you mind explaining where I change the folder path to match that location of the files I want to change?

Many thanks and I hope you pick this up as last post was '15!
 
Check this...

Code:
Option Explicit
Sub rename_3()
Dim NewName As String, mydir As String, objFile As Object

mydir = Application.ThisWorkbook.Path

With CreateObject("Scripting.FileSystemObject")
    For Each objFile In .GetFolder(mydir).Files
        If InStrRev(objFile.Name, "_") Then
            NewName = Replace(objFile.Name, Mid(objFile.Name, _
                    InStrRev(objFile.Name, "_") + 1, InStrRev(objFile.Name, ".") - _
                    InStrRev(objFile.Name, "_") - 1), Format(Date, "YYYYMMDD"))
            Name objFile As Replace(objFile, objFile.Name, NewName)
        End If
    Next
End With

MsgBox "Done"
End Sub
It Worked
 
Back
Top