Question

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

End If
End Sub

Answer 1

为什么不附加“复制xxx”，为什么不附加时间？例如

 "Workbook Name, 2018-04-05 12.30.23.xlsm"

Answer 2

好吧，这个问题可能会有所改变，以获取您想要的东西。通常，您正在寻找一种函数，该函数用点和空格分隔一些字符串，并以1递增最后一个。

例如，如果这是您的输入：

"WorkbookName 12.12.12.xlsm"
"WorkbookName 13.18.22 Copy 230.xlsm"
"WorkbookName 12.11.19 Copy 999.xlsm"

您的函数应提供以下输出：

"WorkbookName 12.12.12.xlsm"
"WorkbookName 13.18.231.xlsm"
"WorkbookName 12.11.1000.xlsm"

完成此操作后，可以通过该功能保存工作簿。这是一些获得输出的函数：

Sub TestMe()        
    Dim path1 As String: path1 = "WorkbookName 12.12.12.xlsm"
    Dim path2 As String: path2 = "WorkbookName 13.18.22 Copy 230.xlsm"
    Dim path3 As String: path3 = "WorkbookName 12.11.19 Copy 999.xlsm"

    Debug.Print changeName(path1)
    Debug.Print changeName(path2)
    Debug.Print changeName(path3)        
End Sub

Public Function changeName(path As String) As String

    changeName = path

    Dim varArr As Variant
    varArr = Split(path, ".")

    Dim splitNumber As Long
    splitNumber = UBound(varArr)

    Dim preLast As String: preLast = varArr(splitNumber - 1)
    If IsNumeric(preLast) Then Exit Function

    Dim lastWithSpace As String
    lastWithSpace = Split(preLast)(UBound(Split(preLast)))
    Dim incrementSome As String
    incrementSome = Left(preLast, Len(preLast) - Len(lastWithSpace))

    If IsNumeric(lastWithSpace) Then
        preLast = Split(preLast)(UBound(Split(preLast))) + 1
        varArr(splitNumber - 1) = incrementSome & preLast
        changeName = Join(varArr, ".")
    End If

End Function

可以对changeName函数进行一些消毒，并进行一些检查，以确定是否存在UBound-1以避免错误。该函数将输入字符串按.符号拆分为数组，然后工作接收到的前一个值然后，如果该值是数字，则不执行任何操作，但是如果该值看起来像22 Copy 230，它将再次拆分并以一个递增最后一个元素。

最后，它返回字符串。

如果您还需要检查日期，则应再增加一层拆分和数组。

Answer 3

听一下，您在原始名称“ Great！”之后添加了一个逗号。（现在使用）

Dim FileName as String, FileExtension as String

FileName = "Workbook Name, Today's Date Copy 2.xlsm"
Pos = InStrRev(FileName, ".") - 1
FileExtension = ".xlsx"    ' <-- Set a default
If Pos > 0 then 
    FileExtension = Mid(FileName, Pos)
    FileName = Left(FileName, Pos)
End if

FileExtension已从FileName中拔出，并且Filename不再具有扩展名。现在放手逗号

Pos = InStrRev(FileName, ",")
If Pos2 > 0 then FileName = Left(FileName, Pos2 -1)

那很容易， FileName 现在已经清除了 Date and Copy 垃圾。尽管您可能在我们清理副本之前就已经寻找过该副本，但我认为尝试几次会更容易，因为您将要检查文件是否存在。

您也可以像提到的PhantomLord一样添加时间。

Dim Try as long
Dim FullName as String

Try = 0     
FullName = Path & FileName & Format(Now, ", d-mm-yyyy") & FileExtension

' Lets put a safety limit to stop the code if something goes wrong
Do While Try < 1000 And Dir(FullName) = vbNullString
    Try = Try + 1
    FullName = Path & FileName & Format(Now, ", d-mm-yyyy") & " Copy " & IIF(Try > 1, Try, vbNullString) & FileExtension
Loop
ActiveWorkbook.SaveAs FileName:=FullName

我什至穿过IIF()玩得开心！

VBA-使用特定的命名约定保存工作簿的多个副本

3 个答案: