时间戳

首页 > 解决方案 > VBA - 保存宏命名工作簿

vba - VBA - 保存宏命名工作簿

问题描述

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

标签： vbaexcel

解决方案

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

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 使用它（我不建议这样做......）

推荐阅读