Vba 保存前更新工作簿上的文件名

我试图让Excel在保存文件时使用唯一的名称保存该文件。
这将主要用于Excel 2003，但也必须用于2010

其思想是，用户打开一个模板文件，如果他们单击“保存”或仅关闭工作簿，它将另存为模板1、模板2等

如果他们单击“保存”，这可以正常工作，但如果他们关闭文件，它会询问您是否要保存对原始文件的更改，以新名称保存，然后询问用户是否要保存更改。。。然后保存并询问用户是否要保存更改，依此类推。显然，我只希望它保存一次，然后关闭，但它没有

我已尝试将

Saved

属性设置为TRUE。我在保存后尝试了

Cancel=True

，但这会导致Excel崩溃，因为Excel遇到了问题，真的需要把你的一天搞砸键入消息

在下面的代码中，我尝试过删除

Saved=TRUE

和

Cancel=TRUE

，我尝试过在

启用事件之前和之后，在
If…End If
块中移动它们-保存前取消，保存后取消：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim NewFileName As String

    On Error GoTo ERROR_HANDLER

    NewFileName = GenerateUniqueName(ThisWorkbook.FullName)
    If NewFileName <> "" Then
        Application.EnableEvents = False
        ThisWorkbook.SaveAs NewFileName, ThisWorkbook.FileFormat
        ThisWorkbook.Saved = True
        Application.EnableEvents = True
    End If

FastExit:

    Cancel = True

    On Error GoTo 0
    Exit Sub

ERROR_HANDLER:
    MsgBox "Error " & Err.Number & vbCr & _
        " (" & Err.Description & ") in procedure ThisWorkbook.Workbook_BeforeSave." & vbCr & vbCr & _
        "DOCUMENT NOT SAVED.", vbCritical + vbOKOnly
    Application.EnableEvents = True
    Resume FastExit

End Sub

在保存之前，我已经更新了我的
代码-我仍然不确定
这个工作簿.Saved=True:Cancel=True
是否正确，但我知道如果我没有输入
Cancel=True
，它会崩溃：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim NewFileName As String

    On Error GoTo ERROR_HANDLER

    ThisWorkbook.Saved = True
    Cancel = True

    NewFileName = GenerateUniqueName(ThisWorkbook.FullName)
    If NewFileName <> "" Then
        Application.EnableEvents = False
        ThisWorkbook.SaveAs NewFileName, ThisWorkbook.FileFormat
        Application.EnableEvents = True
    End If

FastExit:

    On Error GoTo 0
    Exit Sub

ERROR_HANDLER:
    MsgBox "Error " & Err.Number & vbCr & _
        " (" & Err.Description & ") in procedure ThisWorkbook.Workbook_BeforeSave." & vbCr & vbCr & _
        "DOCUMENT NOT SAVED.", vbCritical + vbOKOnly
    Application.EnableEvents = True
    Resume FastExit

End Sub

Private子工作簿\u保存前（ByVal SaveAsUI为布尔值，Cancel为布尔值）
将NewFileName设置为字符串
关于错误转到错误处理程序
ThisWorkbook.Saved=True
取消=真
NewFileName=GenerateUniqueName（ThisWorkbook.FullName）
如果是NewFileName“”，则
Application.EnableEvents=False
ThisWorkbook.SaveAs新文件名，ThisWorkbook.FileFormat
Application.EnableEvents=True
如果结束
快速出口：
错误转到0
出口接头
错误\u处理程序：
MsgBox“错误”和错误编号、vbCr和_
保存前在此工作簿的过程中“（&Err.Description&”）中的“&vbCr&vbCr&_
“文档未保存。”，vbCritical+vbOKOnly
Application.EnableEvents=True
恢复快速退出
端接头

这将使用新名称保存文件，但不会将其关闭

正如苦艾酒和伯恩斯先生所说的，看看最后的事件。

这将查看工作簿是否已保存。如果尚未关闭，则取消关闭事件，保存工作簿，然后将其关闭，否则将不保存而直接关闭

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim NewFileName As String

    If Not ThisWorkbook.Saved Then
        Cancel = True
        NewFileName = GenerateUniqueName(ThisWorkbook.FullName)
        If NewFileName <> "" Then
            Application.EnableEvents = False
            ThisWorkbook.SaveAs NewFileName, ThisWorkbook.FileFormat
            Application.EnableEvents = True
            ThisWorkbook.Close Not ThisWorkbook.Saved
        End If
    End If

End Sub

Private子工作簿\u关闭前（取消为布尔值）
将NewFileName设置为字符串
如果不是，则保存此工作簿
取消=真
NewFileName=GenerateUniqueName（ThisWorkbook.FullName）
如果是NewFileName“”，则
Application.EnableEvents=False
ThisWorkbook.SaveAs新文件名，ThisWorkbook.FileFormat
Application.EnableEvents=True
此工作簿。不关闭此工作簿。已保存
如果结束
如果结束
端接头

有人能发现这里有什么陷阱吗？

编辑：我发现了一个陷阱-你不能使用
另存为
我在保存之前更新了
代码-我仍然不确定
这个工作簿。Saved=True:Cancel=True
是否正确，但我知道如果我不输入
Cancel=True
，它会崩溃：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim NewFileName As String

    On Error GoTo ERROR_HANDLER

    ThisWorkbook.Saved = True
    Cancel = True

    NewFileName = GenerateUniqueName(ThisWorkbook.FullName)
    If NewFileName <> "" Then
        Application.EnableEvents = False
        ThisWorkbook.SaveAs NewFileName, ThisWorkbook.FileFormat
        Application.EnableEvents = True
    End If

FastExit:

    On Error GoTo 0
    Exit Sub

ERROR_HANDLER:
    MsgBox "Error " & Err.Number & vbCr & _
        " (" & Err.Description & ") in procedure ThisWorkbook.Workbook_BeforeSave." & vbCr & vbCr & _
        "DOCUMENT NOT SAVED.", vbCritical + vbOKOnly
    Application.EnableEvents = True
    Resume FastExit

End Sub

Private子工作簿\u保存前（ByVal SaveAsUI为布尔值，Cancel为布尔值）
将NewFileName设置为字符串
关于错误转到错误处理程序
ThisWorkbook.Saved=True
取消=真
NewFileName=GenerateUniqueName（ThisWorkbook.FullName）
如果是NewFileName“”，则
Application.EnableEvents=False
ThisWorkbook.SaveAs新文件名，ThisWorkbook.FileFormat
Application.EnableEvents=True
如果结束
快速出口：
错误转到0
出口接头
错误\u处理程序：
MsgBox“错误”和错误编号、vbCr和_
保存前在此工作簿的过程中“（&Err.Description&”）中的“&vbCr&vbCr&_
“文档未保存。”，vbCritical+vbOKOnly
Application.EnableEvents=True
恢复快速退出
端接头

这将使用新名称保存文件，但不会将其关闭

正如苦艾酒和伯恩斯先生所说的，看看最后的事件。

这将查看工作簿是否已保存。如果尚未关闭，则取消关闭事件，保存工作簿，然后将其关闭，否则将不保存而直接关闭

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim NewFileName As String

    If Not ThisWorkbook.Saved Then
        Cancel = True
        NewFileName = GenerateUniqueName(ThisWorkbook.FullName)
        If NewFileName <> "" Then
            Application.EnableEvents = False
            ThisWorkbook.SaveAs NewFileName, ThisWorkbook.FileFormat
            Application.EnableEvents = True
            ThisWorkbook.Close Not ThisWorkbook.Saved
        End If
    End If

End Sub

Private子工作簿\u关闭前（取消为布尔值）
将NewFileName设置为字符串
如果不是，则保存此工作簿
取消=真
NewFileName=GenerateUniqueName（ThisWorkbook.FullName）
如果是NewFileName“”，则
Application.EnableEvents=False
ThisWorkbook.SaveAs新文件名，ThisWorkbook.FileFormat
Application.EnableEvents=True
此工作簿。不关闭此工作簿。已保存
如果结束
如果结束
端接头

有人能发现这里有什么陷阱吗？

编辑：我发现了一个陷阱-您不能使用
另存为
请尝试一下，看看您的问题是否解决了？我没有将您的功能包括在下面，因为它保持不变

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Ret As Variant

    If ThisWorkbook.Saved = False Then
        ThisWorkbook.Saved = True

        Ret = MsgBox("Would you like to save this workbook?", vbYesNo)

        If Ret = vbYes Then SaveWithUniqueName
    End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If ThisWorkbook.Saved = True Then Exit Sub

    If SaveAsUI = True Then Exit Sub '~~> Checks for Save As

    Cancel = True
    SaveWithUniqueName
End Sub

Sub SaveWithUniqueName()
    Dim NewFileName As String

    On Error GoTo ERROR_HANDLER

        NewFileName = GenerateUniqueName(ThisWorkbook.FullName)

    If NewFileName <> "" Then
        Application.EnableEvents = False
        ThisWorkbook.SaveAs NewFileName, ThisWorkbook.FileFormat
        ThisWorkbook.Saved = True
        Application.EnableEvents = True
    End If

FastExit:
    On Error GoTo 0
    Exit Sub

ERROR_HANDLER:
    MsgBox "Error " & Err.Number & vbCr & _
        " (" & Err.Description & ") in procedure ThisWorkbook.Workbook_BeforeSave." & vbCr & vbCr & _
        "DOCUMENT NOT SAVED.", vbCritical + vbOKOnly
    Application.EnableEvents = True
    Resume FastExit
End Sub

选项显式
私有子工作簿\u关闭前（取消为布尔值）
Dim-Ret作为变体
如果ThisWorkbook.Saved=False，则
ThisWorkbook.Saved=True
Ret=MsgBox（“是否保存此工作簿？”，vbYesNo）
如果Ret=vbYes，则使用UniqueName保存
如果结束
端接头
私有子工作簿\u在保存之前（ByVal SaveAsUI为布尔值，Cancel为布尔值）
如果ThisWorkbook.Saved=True，则退出Sub
如果SaveAsUI=True，则退出子“~~>检查是否另存为
取消=真
使用唯一名称保存
端接头
Sub SaveWithUniqueName（）
将NewFileName设置为字符串
关于错误转到错误处理程序
NewFileName=GenerateUniqueName（ThisWorkbook.FullName）
如果是新的