关闭用户窗体时保存备份

Question

我编写了代码来在关闭用户窗体时保存备份。
当工作簿可见或单击“保存”按钮时它可以工作。

工作簿_BeforeSave 代码。

Privat sub Workbook_BeforeSave(byvale SaveAsUI as Boolean, Cancel as Boolean) 

If MsgBox "some text to inform the user" then

   Save_Backup

End if
End sub

保存_备份代码

Public sub Save_Backup() 

Dim FileName as String 
Dim WbSource as Workbook 
Dim Backup_Folder_Path As String 

On error resume next 
MkDir thisWorkbook.path & "\BackUp" 
Backup_Folder_Path = thisWorkbook.path & "\BackUp"  

On error GoTo 0
Set WbSource = thisWorkbook

FileName = replace(WbSource.Name, "." ,format(Now(), "ddmmyyyy_hhmmss AM/PM."))

WbSource.save
WbSource.Activate
ActiveWorkbook.SaveCopyAs FileName:= Backup_Folder_Path & "\" & FileName 

Set WbSource = Nothing

End Sub

当我检查备份文件夹时，没有文件。

但是关闭用户窗体并且应用程序可见后，当我保存工作簿时，备份完成，我可以在备份文件夹中看到文件。

Answer 1

保存前的工作簿：在每次保存时创建工作簿的备份

工作簿模块(

ThisWorkbook

)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    CreateWorkbookBackup Me, True
End Sub

标准模块，例如

Module1

Sub CreateWorkbookBackup(wb As Workbook, Optional ShowMessages As Boolean = False)
    Const PROC_TITLE As String = "Create Workbook Backup"
    On Error GoTo ClearError
    
    ' Build the destination path.
    Dim dFolderPath As String: dFolderPath = wb.Path
    If Len(wb.Path) = 0 Then
        If ShowMessages Then
            MsgBox "Cannot create a copy of a never saved workbook!", _
                vbExclamation, PROC_TITLE
            Exit Sub
        End If
    End If
    dFolderPath = dFolderPath & Application.PathSeparator & "Backup"
    
    ' Create the destination folder.
    On Error Resume Next ' prevent error if the folder exists
        MkDir dFolderPath
    On Error GoTo ClearError
    
    ' Append a time stamp to the file base name
    ' Don't forget the trailing dot in the timestamp.
    ' If the file name has other dots, it will replace them, too. Improve!
    Dim dFileName As String:
    dFileName = Replace(wb.Name, ".", Format(Now, "ddmmyyyy_hhmmss AM/PM."))
    
    ' Build the destination file path.
    Dim dFilePath As String:
    dFilePath = dFolderPath & Application.PathSeparator & dFileName
    
    ' Save a copy.
    wb.SaveCopyAs Filename:=dFilePath
    
    ' Inform.
    If ShowMessages Then
        MsgBox "Created a backup of the workbook at """ & dFilePath & """.", _
            vbInformation, PROC_TITLE
    End If
    
ProcExit:
    Exit Sub
ClearError:
    ' An unexpected error occured.
    MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf _
        & Err.Description, vbCritical, PROC_TITLE
    Resume ProcExit
End Sub