How to rename a bunch of files in the same folder using an Excel VBA code?

[WiseMan]

Hi everyone. I am glad to be here with after a long wait.


However, I'd love share with my case hopefully, we could come up with a solution.


Briefly, the case is that I'm working on a macro in Excel 365 where the first part of it is to read the names of some files in the same directory.
The names of the files differ every time but they follow a specific pattern as they end in a specific suffix. They look like this:


***X_***X_ABC1
***X_***X_ABC2
***X_***X_ABC3
***X_***X_ABC4


And at the same time and in the same folder, there is another file with a different pattern usually it looks like this
***X_***X_classsheet


What I think of is to use an If statement to rename the files that belong to the first pattern to become like this
ABC1
ABC2
ABC3
ABC4


else it should rename like this
classsheet


Actually, I read and saw some tutorials but none of them gave me what I am after> So, I hope that I have explained my case clearly enough to draw you attention so you might help me to do a neat code that does the job perfectly.


I'll be very thankful to everyone who will dedicate some of his valuable time to look at this and shed some light.


God bless you all.


WiseMan




Office 365

[mike7952]

Give this a try. You don't say what type of files your working with. Change xlsx to fit your needs

Option Explicit
Sub test()
Dim FSO As Object
Dim FLD As Object
Dim fil As Variant
Dim sPath As String
Dim sOldName As String
Dim sNewName As String
Dim sTempFile() As String

'Define the path to the file
sPath = "C:\Users\Mike\Desktop\Excel Forum"
'Create the instance of the FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
'Set the folder you want to search. NOTE - some antivirus may not like this
Set FLD = FSO.GetFolder(sPath)
'Loop through each file in the folder
For Each fil In FLD.Files
'Get complete file name with path
sOldName = fil.Path
'Change to file type you want
If FSO.GetExtensionName(sOldName) = "xlsx" Then
'Check the file has an underscore in the name
If InStr(sOldName, "_") > 0 Then
'Split the file on the underscore so we can get everything before it
sTempFile = Split(sOldName, "_")
'Build the new file name with everything before the
'first under score plus the extension
sNewName = sPath & "\" & sTempFile(UBound(sTempFile))
'Use the MoveFile method to rename the file
FSO.MoveFile sOldName, sNewName
End If
End If
Next
'Cleanup the objects
Set FLD = Nothing
Set FSO = Nothing
End Sub

[WiseMan]

Bingo :clap:. it worked perfectly as hoped.
I really don't know how to thank you, Mike7952.
However, I add your name as a contributor to this tiny project that will definitely serve me and my colleagues.

:friends::friends::friends::friends:

by coming back to the code....

Actually, I have substituted this line:


sPath = "C:\Users\Mike\Desktop\Excel Forum"

which specifies the folder that contains the files with the following piece of code


sPath = ThisWorkbook.Path

because I will always put the script altogether with the files to be renamed in the same folder. So no matter which folder it is.


Yeh, I forgot to mention the extension of the files, but as you know, it does not make that big difference although we work on both types of extensions xls and xlsx.

However, it would nicer if you could recommend a way to do the job automatically without, for example, implementing a dialogue box that asks the user to choose the type of extension of the files. maybe by using a Case statement or anything else like that.

In other words, What is the easiest way to make the code change the names of the files regardless the type of their extensions? In my case, xlx or xlsx everytime, but not xls and xlsx at the same time.

With tons of thanks.

kindly,
MiseMan.

[mike7952]

Is this what you are wanting? Inputbox will prompt for which type of files that you want to work with. Also will create a list of the files that have changed if user selects yes after code is run.


Option Explicit
Const App_Name As String = "Rename files WiseMan v_1.0.0"
Sub RenameFiles()
Dim FSO As Object
Dim FLD As Object
Dim fil As Variant
Dim sPath As String
Dim sOldName As String
Dim sNewName As String
Dim sTempFile() As String
Dim sFileExtention As String
Dim sChangedFiles() As Variant
Dim i As Long

'Use Inputbox to get what files to work with
sFileExtention = Application.InputBox(Prompt:="Enter the file extension to change the names of the files." & vbCrLf & _
"Examples of file extensions: xls, xlsx, xlsm, txt, docx", Title:=App_Name, Default:="xlsx", Type:=2)
ReDim sChangedFiles(0)
sChangedFiles(UBound(sChangedFiles)) = Array("From", "To")
'Define the path to the files
sPath = ThisWorkbook.Path
'Create the instance of the FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
'Set the folder you want to search. NOTE - some antivirus may not like this
Set FLD = FSO.GetFolder(sPath)
'Loop through each file in the folder
For Each fil In FLD.Files
'Get complete file name with path
sOldName = fil.Path
'Change to file type you want
If FSO.GetExtensionName(sOldName) = LCase(Trim$(sFileExtention)) Then
'Check the file has an underscore in the name
If InStr(sOldName, "_") > 0 Then
'Split the file on the underscore so we can get everything before it
sTempFile = Split(sOldName, "_")
'Create an array of file names that have changed
ReDim Preserve sChangedFiles(UBound(sChangedFiles) + 1)
sChangedFiles(UBound(sChangedFiles)) = Array(fil.Name, sTempFile(UBound(sTempFile)))
'Build the new file name with everything before the
'first under score plus the extension
sNewName = sPath & "\" & sTempFile(UBound(sTempFile))
'Use the MoveFile method to rename the file
FSO.MoveFile sOldName, sNewName
End If
End If
Next
'Cleanup the objects
Set FLD = Nothing
Set FSO = Nothing

'Exit sub if no files found
If UBound(sChangedFiles) = 0 Then Exit Sub
'Ask if user would like a list of files that have changed
'Output the files names that have changed. From file name To file name
If MsgBox(Prompt:="Would you like to create a list of files names that have changed?", Buttons:=vbQuestion + vbYesNoCancel, Title:=App_Name) = vbYes Then
Worksheets.Add
For i = 0 To UBound(sChangedFiles)
Cells(i + 1, 1).Resize(, 2) = sChangedFiles(i)
Next
Cells.EntireColumn.AutoFit
End If
End Sub

[WiseMan]

Thank you so much, Mike, for the valuable efforts you put in this thread.

With regard to the latter version of the script, actually it seems a bit more complicated than the former one, and I would recommend if you want to improve to use a user form with some radio buttons for the most common file extensions and an extra input field for anything else.

Personally, I'd love to stick to the first especially after manipulating a bit with the code so that it renames any file within the containing folder regardless the type of its extension if its original name contains an underscore.

Unfortunately, that's ok theoretically but practically I get run-time error number 58 although I run the script in a fresh environment with no similar names at all.
I tried that some many times but all my efforts went in vain. This is applicable to both versions of code.

Moreover, I tried to use "on error goto" statement but it did not work and workbook freezes.

I'd be very grateful if you could spare some of your time to investigate this.

with love
WiseMan

[mike7952]

Yes you're correct, if I was doing this for myself I would probably use a userform and probably use a dialog box to select which folder I want to work with and get a list of all the file extensions in that folder loaded into a listbox and select which files I wanted to work with. Being this a forum that is here to help and not create the whole program for you, I suggest trying to create your userform and writing some code and if you're having problems then I can lend a hand.

File already exists. They may not be similar but after the last _ under score they probably are

Unfortunately, that's ok theoretically but practically I get run-time error number 58 although I run the script in a fresh environment with no similar names at all.

[WiseMan]

and if you're having problems then I can lend a hand.

absolutely you did.

However, I have fixed the runtime error and made the script rename the files in its folder whether they are xls or xlsx files without prompting the user to choose and if there is any name duplication I made it override that and resume next.

Regarding the userform, I don't need it because this code is just the first part of a bigger one and a userform such as the one you just have described is not applicable to my needs.

Last and not least, I thank you so much for your kindness and highly appreciate every single moment you have spent working on this. Really, I feel so obliged to you and hope that one day I return your favor.
Good luck bro.

WiseMan