Access VBA to rename excel workbooks

Asatoma Sadgamaya
Asatoma Sadgamaya used Ask the Experts™
on
Hi,

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

thank you
A
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
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?

Author

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
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
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

Bootstrap 4: Exploring New Features

Learn how to use and navigate the new features included in Bootstrap 4, the most popular HTML, CSS, and JavaScript framework for developing responsive, mobile-first websites.

Author

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
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
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

Author

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
Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Commented:
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

Author

Commented:
Perfect Subodh, that worked for me. Great job.

Thank you so much
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
You're welcome Asatoma! Glad it worked as desired.
Thanks for the feedback and have a good time ahead!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial