excel - 用增量编号重命名打开的工作簿而不先关闭它？

Question

关于这个问题link重命名打开的工作簿而不先关闭它。
提供的答案非常有效，但是如果新名称等于旧名称或者在同一文件夹路径上有一个具有相同新名称的文件，我会遇到这种情况。
我稍微修改了代码(因为新名称将在没有用户干预的情况下被拾取)并添加了在重命名之前检查具有新名称的文件是否存在的功能。
我无法设法添加增量数字(改为添加"new")。
现在，代码仅在第一次运行时才能正常工作:
例如文件名 Plan 12-Mar改为 Plan 12-Mar New和 Plan 12-Mar删除，然后我关闭它。
在重命名文件的第二次运行(Plan 12-Mar New)上，我收到以下消息:file named 'C:\Users\Waleed\Desktop\Plan 12-Mar New.xlsb' already exists in this location. Do you want to replace it?如果我点击是按钮，我会得到这个 Run-time error '70': Permission denied在这行代码Kill FilePath 结论 如果我今天使用代码，如果初始名称是“Plan 12-Mar”，那么预期的操作是(1)保存并重命名为“Plan 12-Mar v2”(2)删除旧文件“Plan 12-Mar”
如果我今天也再次使用，那么预期的操作是(1)保存并重命名为“Plan 12-Mar v3”(2)删除旧文件“Plan 12-Mar v2”。
如果我明天使用该代码，那么预期的操作是(1)保存并重命名为“Plan 13-Mar”(2)删除旧文件“Plan 12-Mar v3”，等等。
感谢您的评论和回答。

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

而这个功能

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

要根据您尝试解释的算法分配新名称，请使用下一个函数:

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

它将在“V”之后添加一个增加现有数字的后缀， 如果名称包含当天引用 和一个包含当前日期的新名称，如果是以前的日期。然后您可以删除带有发送到该函数的名称的工作簿。可以使用下一个 sub 对其进行测试:

Sub testNewName()
   Static name As String
   If name = "" Then name = "Plan 11-Mar.xlsb"
   name = NewName(name): Debug.Print name
End Sub

运行子表单几次，在 Immediate Window 中查看结果.
如果由于未知原因，可以存在与已构建名称相同的全名，则可以检查全名是否存在，并在保存为之前发送有关该信息的消息。