VBA 另存为当前文件名 +01答案

【问题标题】：VBA Save As Current Filename +01VBA 另存为当前文件名 +01
【发布时间】：2023-03-21 15:28:01
【问题描述】：

我正在寻找一个宏来保存我当前版本的文件名 +1 版本的实例。对于每个新的一天，版本将重置为 v01。前任。当前 = DailySheet_20150221v01；另存为 = DailySheet_20150221v02；第二天 = DailySheet_20150222v01

在增加版本号的同时，我希望一旦达到v10+，版本就不必包含v0。

我能够练习如何使用今天的日期保存文件：

Sub CopyDailySheet()

Dim datestr As String

datestr = Format(Now, "yyyymmdd")

ActiveWorkbook.SaveAs "D:\Projects\Daily Sheet\DailySheet_" & datestr & ".xlsx"

End Sub

但在查找版本添加时需要额外帮助。我可以将SaveAs 设置为字符串，然后通过 For/If - Then set 运行它吗？

【问题讨论】：

日期与版本号无关，还是每天都将版本号重置为“1”？
@Porcupine911 是的，我每天都会将版本号重置为“1”
那么我们将不得不使用像 Bu_ali 的 powershell 答案这样的东西。

标签： vba excel iteration filenames save-as

【解决方案1】：

把这个告诉我的几个朋友，下面是他们的解决方案：

Sub Copy_DailySheet()

Dim datestr As String, f As String, CurrentFileDate As String, _
    CurrentVersion As String, SaveAsDate As String, SaveAsVersion As String


    f = ThisWorkbook.FullName
    SaveAsDate = Format(Now, "yyyymmdd")
    ary = Split(f, "_")
    bry = Split(ary(UBound(ary)), "v")
    cry = Split(bry(UBound(bry)), ".")
    CurrentFileDate = bry(0)
    CurrentVersion = cry(0)
    SaveAsDate = Format(Now, "yyyymmdd")

    If SaveAsDate = CurrentFileDate Then
        SaveAsVersion = CurrentVersion + 1
    Else
        SaveAsVersion = 1
    End If

    If SaveAsVersion < 10 Then
        ThisWorkbook.SaveAs "D:\Projects\Daily Sheet\DailySheet_" & SaveAsDate & "v0" & SaveAsVersion & ".xlsm"
    Else
        ThisWorkbook.SaveAs "D:\Projects\Daily Sheet\Daily Sheet_" & SaveAsDate & "v" & SaveAsVersion & ".xlsm"
    End If

End Sub

感谢所有做出贡献的人。

【讨论】：

【解决方案2】：

试试这个：

Sub CopyDailySheet()

'Variables declaration
Dim path As String
Dim sht_nm As String
Dim datestr As String
Dim rev As Integer
Dim chk_fil As Boolean
Dim ws As Object

'Variables initialization
path = "D:\Projects\Daily_Sheet"
sht_nm = "DailySheet"
datestr = Format(Now, "yyyymmdd")
rev = 0

'Create new Windows Shell object
Set ws = CreateObject("Wscript.Shell")

'Check the latest existing revision number
Do
rev = rev + 1
chk_fil = ws.Exec("powershell test-path " & path & "\" & sht_nm & "_" & datestr & "v" & Format(rev, "00") & ".*").StdOut.ReadLine
Loop While chk_fil = True

'Save File with new revision number
ActiveWorkbook.SaveAs path & "\" & sht_nm & "_" & datestr & "v" & Format(rev, "00") & ".xlsm"

End Sub

【讨论】：

WshShell 有什么特别需要我做的吗？我在Dim ws As WshShell 上收到编译错误：未定义用户定义类型。
哦，对不起，忘了说你应该包括相应的参考。您可以这样做： 1- 在 Excel 中打开 MS VBA 2- 单击工具栏中的 Tools 3- 选择 References 4- 查找 Windows Script Host对象模型 引用并通过选中它旁边的框来添加它 5- 单击确定 6- 再次编译脚本
或者您可以只替换以下内容：Dim ws As WshShell 与 Dim ws As Object 和 Set ws = New WshShell 与 Set ws = CreateObject("Wscript.Shell")
这将打开并运行 Windows PowerShell，但随后会产生 Run-Time error '13': Type mismatch 。调试亮点chk_fil = ws.Exec("powershell test-path " & path & "\" & sht_nm & "_" & datestr & "v" & Format(rev, "00") & ".*").StdOut.ReadLine
您只需要更改路径名。无论如何，我已在代码中为您将其更改为 "D:\Projects\Daily Sheet"，并更改了 ws 变量的声明（迟到- bound) 所以你不会再遇到那个编译错误了。请重新复制代码。

【解决方案3】：

如果你有当前的文件名，我会使用类似：

Public Function GetNewFileName(s As String) As String
    ary = Split(s, "v")
    n = "0" & CStr(CLng(ary(1)) + 1)
    GetNewFileName = ary(0) & "v" & ary(1)
End Function

测试：

Sub MAIN()
    strng = GetNewFileName("DailySheet_20150221v02")
    MsgBox strng
End Sub

【讨论】：

所以总是用零填充。 “v010”？
@Gary 的学生我很想了解您的 Function 和 Sub，但不了解信息是如何传递的。当我运行它时，我得到MsgBox 和DailySheet_20150221v02。我可以将它们放在同一个模块中吗？