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

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

CodePudding user response：

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.