为什么ThisWorkbook.SaveCopyAs在宏运行时工作，但在没有运行时会运行？

Question

以下VBA代码旨在运行于MS Office 2003。因为这是我们数十亿美元的公司给我们的合作伙伴。 =）

好消息。如果我在IDE中编辑代码并点击保存，它会很好地工作。如果我正在处理电子表格本身，也一样。如果不存在，则创建一个备份文件夹，并在其中保存一个过时的备份副本。

坏消息。当我运行主宏（太大而不能发布）时，下面的代码会执行但不保存备份副本。该事件被正确调用。实际上，如果不存在，它将创建一个备份文件夹。每条线都可以运行。这些变量都是正确的。错误处理工作。

简单地说，如果主宏正在运行并调用ThisWorkbook.Save，则ThisWorkbook.SaveCopyAs将不起作用。

我几个月前才知道这个特定项目的VBA，所以如果有什么明显的道歉，但是，我阅读了所有相关的MSDN文档并疯狂地Google搜索，但没有出现。

在此先感谢您的帮助。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 

'******************************************************************** 
'Purpose: Triggered by ThisWorkbook.BeforeSave event 
'   Creates backup folder and saves date appended copies 
'******************************************************************** 

    Dim strBackupPath As String   'Path to Backup Folder 
    Dim strFarkPath As String   'Path to running workbook 
    Dim strBackupName As String   'Filename of backup 
    Dim strFullName As String   'Full path & filename of running workbook 
    Dim strBackupExtension As String 'Extension of backup 
    Dim strDestination As String  'Full path & filename of backup 
    Dim strDrive As String    'Drive letter 

    strFarkPath = Application.ActiveWorkbook.Path 
    strDrive = Left(strFarkPath, 1) 
    strBackupPath = strFarkPath & "\_Backups" 
    strBackupName = "\Backup-" & Year(Now) & "-" & Month(Now) & "-" & Day(Now) 
    strFullName = Application.ActiveWorkbook.FullName 
    strBackupExtension = Right(strFullName, Len(strFullName) - InStrRev(strFullName, ".", -1, vbTextCompare) + 1) 
    strDestination = strBackupPath & strBackupName & strBackupExtension 

    On Error GoTo Incorrect 

    If Len(Dir(strBackupPath, vbDirectory)) = 0 Then 
     MkDir strBackupPath 
    End If 

    Application.DisplayAlerts = False 
    ThisWorkbook.SaveCopyAs Filename:=strDestination 
    Application.DisplayAlerts = True 
    Exit Sub 

Incorrect: 
    MsgBox "Unable to back record keeper up. Next time, please run the program from a location where you can read and write files.", vbCritical + vbOKOnly 

End Sub 

Answer 1

下面是您的现有子的最后一部分，修改后创建一个副本。 注意不能使用内置FileCopy，使复印件（你会得到“权限被拒绝”）

On Error GoTo Incorrect 

    If Len(Dir(strBackupPath, vbDirectory)) = 0 Then 
     MkDir strBackupPath 
    End If 

    Application.DisplayAlerts = False 

    Application.EnableEvents = False 
    ThisWorkbook.Save 

    CreateObject("scripting.filesystemobject").copyfile _ 
        ThisWorkbook.FullName, strDestination 

    Application.EnableEvents = True '<<<< 

    Application.DisplayAlerts = True 

    Exit Sub 

Incorrect: 
    Application.EnableEvents = True 'never leave this False! 
    MsgBox "Unable to back record keeper up. Next time, please run the program from a location where you can read and write files.", vbCritical + vbOKOnly 
End Sub