Rename opened workbook with incremental number without firstly closing it? - excel

Question

Regarding this question link to rename opened workbook without firstly close it.
The provided answer works greatly ,But I faced cases if new name equal to old name or there is a file with same new name on same folder path.
I modified the code a bit ( as new name will be picked up without user intervention) and added function to check if a file with new name exists or not before rename.
I could not manage to add the incremental number ( added “New” instead).
Now, the code works properly only on first run:
e.g. file name Plan 12-Mar changed to Plan 12-Mar New and Plan 12-Mar deleted , then I closed it.
On second run on the renamed file (Plan 12-Mar New) I got the following message:
file named 'C:\Users\Waleed\Desktop\Plan 12-Mar New.xlsb' already exists in this location. Do you want to replace it?
If I clicked on Yes button , I got this Run-time error '70': Permission denied on this line of code Kill FilePath
Conclusion if I used the code today , if initial name is “Plan 12-Mar” ,then expected actions are (1) save as with rename to “Plan 12-Mar v2” (2) delete the old file “Plan 12-Mar”
and if also I used again today, then expected actions are (1) save as with rename to “Plan 12-Mar v3” (2) delete the old file “Plan 12-Mar v2”.
If I used the code tomorrow, then expected actions are (1) save as with rename to “Plan 13-Mar” (2) delete the old file “Plan 12-Mar v3” , and so on.
Appreciate for yours comments and answers.
Option Explicit
Option Compare Text
Sub Rename_Me()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim DotPosition As Long: DotPosition = InStr(1, wb.Name, ".")
If DotPosition = 0 Then Exit Sub
Dim ibDefault As String: ibDefault = Left(wb.Name, DotPosition - 1)
Dim NewBaseName As String
NewBaseName = "Plan " & Format(Date, "DD-MMM")
If Len(NewBaseName) = 0 Then Exit Sub
Dim FilePath As String: FilePath = wb.FullName
Dim FolderPath As String: FolderPath = wb.path & Application.PathSeparator
Dim Extension As String: Extension = Right(Extension, DotPosition)
Dim ErrNum As Long
On Error Resume Next
If Not Is_File_Exists(wb.FullName) Then
wb.SaveAs FolderPath & NewBaseName & Extension
ErrNum = Err.Number
Else
wb.SaveAs FolderPath & NewBaseName & " New" & Extension 'Instead of "New" ,I v2 ,v3,...
ErrNum = Err.Number
End If
On Error GoTo 0
If ErrNum = 0 Then
Kill FilePath
Else
Kill FilePath
MsgBox "Could not rename.", vbCritical, "Rename Me"
End If
End Sub
And this the function
Function Is_File_Exists(ByVal fName As String) As Boolean
'Returns TRUE if the provided name points to an existing file,
'FALSE if not existing or it's a folder
On Error Resume Next
Is_File_Exists = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
End Function

Answer 1

To allocate a new name, based on the algorithm you try explaining, please use the next function:
Function NewName(strExisting As String) As String
Dim boolToday As Boolean, arrSuffix, arrName, nrSuffix As Long
arrName = Split(strExisting, "."): strExisting = arrName(0)
'check if the root name refers to today date:
If InStr(strExisting, "Plan " & Format(Date, "DD-MMM")) > 0 Then boolToday = True
If boolToday Then
If IsNumeric(Right(strExisting, 1)) Then
arrSuffix = Split(strExisting, " V"): nrSuffix = CLng(arrSuffix(1)) + 1
NewName = arrSuffix(0) & " V" & nrSuffix & "." & arrName(1): Exit Function
Else
NewName = strExisting & " V1." & arrName(1): Exit Function
End If
Else
NewName = "Plan " & Format(Date, "DD-MMM") & "." & arrName(1): Exit Function
End If
End Function
It will add a suffix incrementing the existing number after "V", in case of the name containing current day reference and a new name containing the current date, if a previous one. Then you can delete the workbook with the name sent to the function. It can be tested using the next sub:
Sub testNewName()
Static name As String
If name = "" Then name = "Plan 11-Mar.xlsb"
name = NewName(name): Debug.Print name
End Sub
Run the sub form some times and see the result in Immediate Window.
If, from unknow reasons, a full name identic to the built one can exist, the full name can be checked for its existence and send a message about that before saving As.