Rename multiple files in a folder with a macro

Rui Pires · May 19, 2015

hi all;

I have multiple files in a folder and I want to rename them automatically via a macro as shown below.
Can you help me in this challenge?

Thanks for your support.

Deepak · May 19, 2015

Check this..

http://forum.chandoo.org/threads/macro-to-rename-files.22787/

Rui Pires · May 19, 2015

Hi Deepak , thank you for your solution , but in my case it is different,
It did not work for me

.

Deepak · May 19, 2015

Rui Pires said:
Hi Deepak , thank you for your solution , but in my case it is different,
It did not work for me .

So, Pls be specific & also share the sample xl with manual calculation/steps.

Rui Pires · May 19, 2015

Deepak said:
So, Pls be specific & also share the sample xl with manual calculation/steps.

So I have some files in any folder , and i want a simple macro to read all the files and rename them to the syntax that I show in Figure, so in the same folder i have the macro file and the files all renamed. It is simple

Thank you Deepak

Deepak · May 19, 2015

You mean to say that rename the last part of file name followed by "_" with YYYYMMDD

Rui Pires · May 19, 2015

Deepak said:
You mean to say that rename the last part of file name followed by "_" with YYYYMMDD

ie : "ID_2G_SCF_54545455455.xml" will be "ID_2G_SCF_20150519.xml "

and ID_2G_RSSI_2112121212112.txt will be "ID_2G_RSSI_20150519.txt "

and so on until the end of the files

THANKS

Deepak · May 19, 2015

Something like as ...

Code:

Option Explicit
Sub rename_2()
Dim OldName As String, NewName As String, mydir As String, r As Range

mydir = Application.ThisWorkbook.Path & "\"

For Each r In Range("A1:A10")
    OldName = r
    NewName = Left(r, Len(r) - InStrRev(r, "_")) & Format(Date, "YYYYMMDD")
    Name mydir & OldName As mydir & NewName
Next

End Sub

Rui Pires · May 19, 2015

Deepak said:

Something like as ...

Code:

Option Explicit
Sub rename_2()
Dim OldName As String, NewName As String, mydir As String, r As Range

mydir = Application.ThisWorkbook.Path & "\"

For Each r In Range("A1:A10")
    OldName = r
    NewName = Left(r, Len(r) - InStrRev(r, "_")) & Format(Date, "YYYYMMDD")
    Name mydir & OldName As mydir & NewName
Next

End Sub

Deepack as you see on pic , i dont know where the error is, why you put
r In Range("A1:A10") ?? in the A1:A10 there is no values!! the macro must read the name files on the folder as you see on pic attached
thanks

Deepak · May 19, 2015

I said like something not copy paste & run the code.

Pls wait for sometimes, i will get back to you with copy-paste code.

Rui Pires · May 19, 2015

Deepak said:
I said like something not copy paste & run the code.

Pls wait for sometimes, i will get back to you with copy-paste code.

I assigned your code to my button - " rename files" and i change the path because first i have got message error in the path
Ok thanks very much, i appreciate

Deepak · May 19, 2015

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

Rui Pires · May 19, 2015

Deepak said:

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

Hi Deepack , only work with one file

thank you again

Deepak · May 20, 2015

Rui Pires said:
Hi Deepack , only work with one file
thank you again

You might did something wrong as i have tested before posting.
pls share the before and after screenshot.

Rui Pires · May 20, 2015

Deepak said:
You might did something wrong as i have tested before posting.
pls share the before and after screenshot.

Hi Deepak, please read this doc that i've write to you

Deepak · May 20, 2015

Rui Pires said:
Hi Deepak, please read this doc that i've write to you

Ok got your point, Will take sometimes i am little busy right now .Stay tuned.

Rui Pires · May 20, 2015

OK no worries, when you havê time, many tks

Deepak · May 20, 2015

Hi Rui,

Something might still needs to alter...non tested too!!

Code:

Option Explicit
Sub rename_4()
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
        If Not InStrRev(objFile.Name, "_") Then GoTo N
           
            Last_name = Mid(objFile.Name, _
                    InStrRev(objFile.Name, "_") + 1, InStrRev(objFile.Name, ".") - _
                    InStrRev(objFile.Name, "_") - 1)
       
        If IsNumeric(Last_name) Then
            NewName = Replace(objFile.Name, Last_name, Format(Date, "YYYYMMDD"))
        Else
            NewName = Replace(objFile.Name, Last_name, Last_name & "_" & Format(Date, "YYYYMMDD"))
        End If
       
        NewName = Replace(NewName, id, "")
        NewName = id & "_" & NewName
       
        Name objFile As Replace(objFile, objFile.Name, NewName)
           
N:    Next
End With

MsgBox "Done"
End Sub

Rui Pires · May 20, 2015

Hi Deepack the code works if i remove this line
"If Not InStrRev(objFile.Name, "_") ThenGoTo N "
and " N:" ,after that i have an error debug
on " Name objFile As Replace(objFile, objFile.Name, NewName) " but the file
was renamed !! But that is not what i want !

before original name : " 2G_15893_MML.txt "
after "15893_2G_15893_MML_20052015.txt "

and i want "15893_2G_MML_20052015.txt" like in the pic that i sent to you

Anyway thanks for helping me out

Deepak · May 21, 2015

Pls take penalty to paste here names of before and after.

Rui Pires · May 21, 2015

Deepak said:
Pls take penalty to paste here names of before and after.

Hi, Deepak,please read this doc that I wrote for you.

Deepak · May 21, 2015

Rui Pires said:
Hi, Deepak,please read this doc that I wrote for you.

I have asked names not picture..
Like as
Before - After as per you without any macro.

Rui Pires · May 21, 2015

Deepak said:
I have asked names not picture..
Like as
Before - After as per you without any macro.

BEFORE Can be like this

5455454564_BSC393588_BCF14.xls

5565006_MRBTS18311_LN5.0_minCIQ.xlsx

21783_BSC393588_BCF14.xls

21783_MRBTS18311_LN5.0.xml

And AFTER

<ID>_BSC393588_BCF14_<DATA>.xls

<ID>_MRBTS18311_LN5.0_minCIQ_<DATA>.xlsx

<ID>_BSC393588_<DATA>.xls

<ID>_MRBTS18311_LN5.0_<DATA>.xml

THANKS DEEPAK.

Deepak · May 21, 2015

Stay tuned...

Deepak · May 21, 2015

Pls explain

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

where's the bold part gone.

Rename multiple files in a folder with a macro

Member

Attachments

Excel Ninja

Member

Excel Ninja

Member

Attachments

Excel Ninja

Member

Excel Ninja

Member

Attachments

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Attachments

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Attachments

Excel Ninja

Member

Excel Ninja

Excel Ninja