Question

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

在增加版本号的同时，我希望在达到v0 +后，版本不会包含v10。

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

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？

运行它

Answer 1

试试这个：

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

Answer 2

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

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

Answer 3

把它交给我的几个朋友，下面是他们的解决方案：

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

感谢所有贡献者。

VBA另存为当前文件名+01

3 个答案: