Question

我下面有代码保存当前工作簿，并将今天的日期附加到文件名的末尾。我将如何修改代码，以便如果要在同一天保存工作簿的两个副本，则第一个通常将另存为“ 工作簿名称，今天的Date.xlsm ”，而第二个将保存为另存为“ 工作簿名称，今天的日期副本2.xlsm ”，而不是“ 工作簿名称，今天的日期，今天的Date.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`

Answer 1

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

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....

曾经有一种使用命令提示符执行此操作的更干净的方法，但是近年来，Windows似乎不再允许通过VBA在不更改安全设置的情况下使用它（我不建议...）< / p>

Answer 2

If Dir(Path & Left(ActiveWorkbook.Name, Pos) & Format    (Now, "d-mm-yyyy") & Mid(ActiveWorkbook.Name, Pos + 1)) <> "" Then
        ActiveWorkbook.SaveAs Filename:=Path & Left(ActiveWorkbook.Name, Pos) & copy 2 & Mid(ActiveWorkbook.Name, Pos + 1)
Else
        ActiveWorkbook.SaveAs Filename:=Path & Left(ActiveWorkbook.Name, Pos) & Format    (Now, "d-mm-yyyy") & Mid(ActiveWorkbook.Name, Pos + 1)

使用此保存文件

VBA-保存宏命名工作簿

2 个答案: