VBA Macro to Rename the Excel Files in a Folder
Sub ReNameFiles()
Dim MyObj As Object, SrcDir As String, ObjFile As Object
SrcDir = ("C:\Users\Reddy\Desktop\Tamatam\Test\")
Set MyObj = CreateObject("Scripting.FileSystemObject")
For Each ObjFile In MyObj.GetFolder(SrcDir).Files
'Rename only the Excel Files
If InStr(ObjFile.Name, ".xls") = 0 Then Exit For
If InStr(1, ObjFile.Name, "Dashboard") > 0 Then
Pos = InStr(5, ObjFile.Name, "_")
Else
Pos = InStr(1, ObjFile.Name, "-")
End If
FilName = Left(ObjFile.Name, Pos - 1)
ID = Trim(StrReverse(Right(Left(StrReverse(ObjFile.Name), 10), 5)))
FY= "FY16"
New_Name = FilName & "_" & FY & " - " & ID & ".xlsx"
'Renaming the File
ObjFile.Name = New_Name
Next ObjFile
End Sub
Output :
Sub ReNameFiles()
Dim MyObj As Object, SrcDir As String, ObjFile As Object
SrcDir = ("C:\Users\Reddy\Desktop\Tamatam\Test\")
Set MyObj = CreateObject("Scripting.FileSystemObject")
For Each ObjFile In MyObj.GetFolder(SrcDir).Files
'Rename only the Excel Files
If InStr(ObjFile.Name, ".xls") = 0 Then Exit For
If InStr(1, ObjFile.Name, "Dashboard") > 0 Then
Pos = InStr(5, ObjFile.Name, "_")
Else
Pos = InStr(1, ObjFile.Name, "-")
End If
FilName = Left(ObjFile.Name, Pos - 1)
ID = Trim(StrReverse(Right(Left(StrReverse(ObjFile.Name), 10), 5)))
FY= "FY16"
New_Name = FilName & "_" & FY & " - " & ID & ".xlsx"
'Renaming the File
ObjFile.Name = New_Name
Next ObjFile
End Sub
Output :
After renaming the files :
#--------------------------------------------------------------Thanks--------------------------------------------------------------#
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.