爲什麼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