用增量編號重命名打開的作業簿而不先關閉它？

關于這個問題 鏈接重命名打開的作業簿而不先關閉它。
提供的答案非常有效，但是如果新名稱等于舊名稱或者在同一檔案夾路徑上有一個具有相同新名稱的檔案，我會遇到這種情況。
我稍微修改了代碼（因為新名稱將在沒有用戶干預的情況下被拾取）并添加了在重命名之前檢查具有新名稱的檔案是否存在的功能。
我無法設法添加增量數字（改為添加“新”）。
現在，代碼僅在第一次運行時才能正常作業：
例如檔案名 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）洗掉舊檔案“計劃 3 月 12 日 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

uj5u.com熱心網友回復：

要根據您嘗試解釋的演算法分配新名稱，請使用下一個函式：

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。

如果由于未知原因，可以存在與已構建名稱相同的全名，則可以檢查全名是否存在，并在保存為之前發送有關該資訊的訊息。

標籤：擅长 vba

上一篇：如何從AzureAD中查找重復用戶？

下一篇：如何通過讀取單元格中的路徑在VBA中運行Python腳本？