VBA另存为当前文件名+01

Question

我正在寻找一个宏来保存我当前版本的文件名+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 运行 - 然后设置吗？

Answer 1

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

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

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

VBA Save As Current Filename +01

vba

excel

iteration

filenames

save-as