Rename multiple files in a folder with a macro

[Rui Pires]

Pls explain

How 21783_BSC393588_BCF14.xls became <ID>_BSC393588_<DATA>.xls

where's the bold part gone.

Sorry, must be <ID>_BSC393588_BCF14_<DATA>.xls

 

[Deepak]

& these two will be what

2G_OSS_15893_255555.xls = ??
2G_OSS_255555.xls = ??
15893_abcd_xyz = ??

& why

 

[Rui Pires]

forget these examples please!
Thank you

 

[Deepak]

Check this...

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

 

[Rui Pires]

Check this...

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

 

[Deepak]

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.

 

[Rui Pires]

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.

 

[Deepak]

Let us know if any further assistance is req...

 

[Mitch]

Hi hope that this helps, it's a workbook dedicated just for this! It can rename any file on your system.
You can download the file directly from his website

http://www.spreadsheetcreative.com/rename-multiple-files-on-your-system/

 

[VBA beginer]

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!

 

[Deepak]

mydir = Application.ThisWorkbook.Path

Change as need.

 

[VBA beginer]

Hi Deepak,

Appreciate the response and many thanks for the quick fix.

 

[android.ashishp]

Check this...

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