Access VBA to rename excel workbooks

Hi,

I am in search for a access vba script to rename excel workbooks.

thank you
A
Asatoma SadgamayaAnalystAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You mean, you want to rename all the excel files saved in a folder? What would be the criteria for new names for those excel files?
0
Asatoma SadgamayaAnalystAuthor Commented:
Hi Subodh, nice to see you again.

I have 5 excel files in a folder. each has got some name with date. (ie: Abcd Efghi Jklm_04Oct18.xlsx)

1. I need a vba code to rename it to file names without date. (ie:  Abcd Efghi Jklm_04Oct18.xlsx  to  Abcd Efghi Jklm.xlsx)

I have some vba code to run here to update report

2. Again, I need a vba code to rename it back to current date. (ie: Abcd Efghi Jklm.xlsx  to  Abcd Efghi Jklm_05Oct18.xlsx)

Hope you get me

Thank you
A
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
The following code will remove the data part from the excel files provided file names and the date part are concatenated with a underscore "_" as per your description.

Also, you will need to change the path of the folder where all the excel files are saved at line#10 in the following code.

Sub RenameExcelFiles()
Dim fso As Object
Dim srcFolder As Object
Dim xlFile As Object
Dim xlApp As Object
Dim wb As Object
Dim FolderPath As String
Dim NewFileName As String

FolderPath = Environ("UserProfile") & "\Desktop\Test\"      'Path of source folder with Excel Files
Set fso = CreateObject("Scripting.FileSystemObject")
Set srcFolder = fso.GetFolder(FolderPath)

Set xlApp = CreateObject("Excel.Application")

For Each xlFile In srcFolder.Files
    If fso.GetExtensionName(xlFile) = "xlsx" Then
        If InStr(xlFile.Name, "_") > 0 Then
            Set wb = xlApp.workbooks.Open(xlFile)
            NewFileName = Split(xlFile.Name, "_")(0) & ".xlsx"
            wb.saveas FolderPath & NewFileName, 51
            wb.Close True
            Kill xlFile
        End If
        
    End If
Next xlFile
Set xlApp = Nothing
End Sub

Open in new window

0
OWASP: Forgery and Phishing

Learn the techniques to avoid forgery and phishing attacks and the types of attacks an application or network may face.

Asatoma SadgamayaAnalystAuthor Commented:
Thank you Subodh, I know you are a star when it comes to vba.

I am rally sorry, my requirement has slightly changed.

I just need a vba code to change the date of filename to today's date; I need to run this code everyday.
ie ABCD EFG HIJK_04Oct18.xlsx  to  ABCD EFG HIJK_05Oct18.xlsx

All 5 excel files are in a folder called Upload folder. I just want to change this file names to file name_today's date.

Sorry for this hassle
A
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
No problem. Try this...

Sub RenameExcelFiles()
Dim fso As Object
Dim srcFolder As Object
Dim xlFile As Object
Dim xlApp As Object
Dim wb As Object
Dim FolderPath As String
Dim NewFileName As String
Dim strDate As String

FolderPath = Environ("UserProfile") & "\Desktop\Test\"      'Path of source folder with Excel Files
Set fso = CreateObject("Scripting.FileSystemObject")
Set srcFolder = fso.GetFolder(FolderPath)

Set xlApp = CreateObject("Excel.Application")
xlApp.Application.displayalerts = False
strDate = Format(Date, "ddmmmyy")
On Error Resume Next
For Each xlFile In srcFolder.Files
    If fso.GetExtensionName(xlFile) = "xlsx" Then
        If InStr(xlFile.Name, "_") > 0 Then
            Set wb = xlApp.workbooks.Open(xlFile)
            NewFileName = Split(xlFile.Name, "_")(0) & "_" & strDate & ".xlsx"
            wb.saveas FolderPath & NewFileName, 51
            wb.Close True
            Kill xlFile
        End If        
    End If
Next xlFile
Set xlApp = Nothing
End Sub

Open in new window

0
Asatoma SadgamayaAnalystAuthor Commented:
Hi Subodh,

I have tried your last code,

1. it is changing/adding today's date only for one file.
2. If I run the code again, it deletes that file.( I need the file with new date on it, but not to be deleted)

What i need is, All the excel files in the Upload folder need to be re-named as file name_today's date.xlsx

eg.
abcd efg.xlsx--->abc efg_05Oct18.xlsx (even you can ignore this eg because all 5 files has got date at the end)
Hij klm_04Oct18.xlsx---> Hij klm_05Oct18.xlsx (this is what exactly I am after)


Thank you for your help
A
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Okay, see if the following code works for you.

Sub RenameExcelFiles()
Dim fso As Object
Dim srcFolder As Object
Dim xlFile As Object
Dim xlApp As Object
Dim wb As Object
Dim FolderPath As String
Dim NewFileName As String, oldName As String
Dim strDate As String

FolderPath = Environ("UserProfile") & "\Desktop\Test\"      'Path of source folder with Excel Files
Set fso = CreateObject("Scripting.FileSystemObject")
Set srcFolder = fso.GetFolder(FolderPath)

Set xlApp = CreateObject("Excel.Application")
xlApp.Application.displayalerts = False
strDate = Format(Date, "ddmmmyy")
On Error Resume Next
For Each xlFile In srcFolder.Files
    If fso.GetExtensionName(xlFile) = "xlsx" Then
        Set wb = xlApp.workbooks.Open(xlFile)
        oldName = wb.Name
        If InStr(xlFile.Name, "_") > 0 Then
            NewFileName = Split(xlFile.Name, "_")(0) & "_" & strDate & ".xlsx"
        Else
            NewFileName = Left(xlFile.Name, InStr(xlFile.Name, ".") - 1) & "_" & strDate & ".xlsx"
        End If
        wb.saveas FolderPath & NewFileName, 51
        wb.Close True
        If oldName <> NewFileName Then Kill xlFile
    End If
Next xlFile
Set xlApp = Nothing
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Asatoma SadgamayaAnalystAuthor Commented:
Perfect Subodh, that worked for me. Great job.

Thank you so much
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Asatoma! Glad it worked as desired.
Thanks for the feedback and have a good time ahead!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.