VBA-保存宏命名工作簿

我有下面的代码来保存当前工作簿，并将今天的日期附加到文件名的末尾。如何修改代码，以便在同一天保存两份工作簿时，第一份通常保存为“工作簿名称，今天的日期.xlsm”，第二份保存为“工作簿名称，今天的日期副本2.xlsm”，而不是“工作簿名称，今天的日期，今天的日期.xlsm”（将日期两次附加到文件名的末尾，现在就是这样做的）。如果工作簿每天保存3、4、5次，则它们应另存为副本3、4、5等

`Sub Save_Workbook()

Const Path = "H:\HR\Cole G\Timehseet Test Path\"
Dim FileName As String
Dim Pos As Long

Pos = InStrRev(ActiveWorkbook.Name, ".") - 1
' If there wasn't a ".", then the file doesn't have an extension and Pos = -1
If Pos < 0 Then Pos = Len(ActiveWorkbook.Name)

' Now put everything together, including the file extension...
ActiveWorkbook.SaveAs Path & Left(ActiveWorkbook.Name, Pos) & Format    (Now, "d-mm-yyyy") & Mid(ActiveWorkbook.Name, Pos + 1)

End Sub`

`Sub Save_工作簿（）
Const Path=“H:\HR\Cole G\Timehseet测试路径”
将文件名设置为字符串
变暗位置尽可能长
Pos=InStrRev（ActiveWorkbook.Name，“.”-1
'如果没有'，则该文件没有扩展名，并且Pos=-1
如果Pos<0，则Pos=Len（ActiveWorkbook.Name）
'现在将所有内容放在一起，包括文件扩展名。。。
ActiveWorkbook.SaveAs路径和左侧（ActiveWorkbook.Name，Pos）和格式（现在为“d-mm-yyyy”）&中间（ActiveWorkbook.Name，Pos+1）
端接头`

如果Dir（Path&Left（ActiveWorkbook.Name，Pos）和Format（现在是“d-mm-yyyy”）&Mid（ActiveWorkbook.Name，Pos+1））“”那么
ActiveWorkbook.SaveAs文件名：=路径和左侧（ActiveWorkbook.Name，Pos）和副本2&Mid（ActiveWorkbook.Name，Pos+1）
其他的
ActiveWorkbook.SaveAs文件名：=路径和左侧（ActiveWorkbook.Name，Pos）和格式（现在为“d-mm-yyyy”）&中间（ActiveWorkbook.Name，Pos+1）

---

使用此选项保存文件

您可以尝试这样的递归方法（未经测试）：

然后将代码更改为以下内容：

Dim potentialFileName As String    
potentialFileName = Path & Left(ActiveWorkbook.Name, Pos) & Format(Now, "d-mm-yyyy") & Mid(ActiveWorkbook.Name, Pos + 1)

If FileLen(potentialFileName) Then
    CreateCopyFile(potentialFileName)
Else
    ActiveWorkbook.SaveAs potentialFileName
End If

'// rest of code here.... 

---

以前有一种更干净的方法可以使用命令提示符来实现这一点，但近年来，Windows似乎不再允许在不更改安全设置的情况下通过VBA使用它（我不建议…）

您必须读取文件保存位置，以确保另一个同名文件不存在。如果存在，请读取文件名并在文件夹中进行复制和“复制”计数+1@Cyril啊，好吧，我试试看！谢谢！这会删除日期并用副本2替换

Sub CreateCopyFile(ByVal oldFileName As String, Optional ByVal copyNo As Long = 1)
    If FileLen(oldFileName & " Copy (" & copyNo & ")") Then
        CreateCopyFile(oldFileName, copyNo + 1)
    Else
        ActiveWorkbook.SaveAs oldFileName & " Copy (" & copyNo & ")"
    End If
End Sub

Dim potentialFileName As String    
potentialFileName = Path & Left(ActiveWorkbook.Name, Pos) & Format(Now, "d-mm-yyyy") & Mid(ActiveWorkbook.Name, Pos + 1)

If FileLen(potentialFileName) Then
    CreateCopyFile(potentialFileName)
Else
    ActiveWorkbook.SaveAs potentialFileName
End If

'// rest of code here....