为什么不会ThisWorkbook.SaveCopyAsmacros运行时工作，但它没有运行时呢？
下面的VBA代码是为了在MS Office 2003上运行。 因为这是我们数十亿美元的公司给我们的工作。 =）
好消息。 如果我在IDE中编辑代码并点击保存，它将完美工作。 如果我正在处理电子表格，那也一样。 创build一个备份文件夹，如果不存在，并保存一个过时的备份副本。
坏消息。 当我运行主macros（太大，不能发布），下面的代码执行，但不保存备份副本。 事件被正确地调用。 实际上，如果不存在，它将创build一个备份文件夹。 每条线都可以运行。 variables都是正确的。 error handling工作。
简单地说，如果主macros正在运行并调用ThisWorkbook.Save，则ThisWorkbook.SaveCopyAs将不起作用。
我几个月前才学习过这个特定项目的VBA，所以很抱歉，如果有什么明显的。 但是，我读了所有相关的MSDN文档，并疯狂地Googlesearch，但没有出现。
提前感谢你的帮助。
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 这里是你现有的子的最后一部分，修改后创build一个副本。 请注意，您不能使用内置的FileCopy来创build副本（您将获得“权限被拒绝”）
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