将Excel文件保存在两个不同的位置
我必须这样做，只要我保存Excel文件：
-
将文件保存在一个驱动器位置（如果存在同名文件，则覆盖）
-
回到文件的原始位置，并保存在那里（覆盖文件）
码：
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False Dim thisPath As String Dim oneDrivePath As String thisPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name oneDrivePath = "C:\Users\Folder\OneDrive\" & ThisWorkbook.Name ActiveWorkbook.SaveAs _ Filename:=oneDrivePath Do Loop Until ThisWorkbook.Saved ActiveWorkbook.SaveAs _ Filename:=thisPath Do Loop Until ThisWorkbook.Saved Application.DisplayAlerts = True Application.EnableEvents = True Application.ScreenUpdating = True End Sub 但是这不起作用，在无限循环中，或者Excel进入非响应状态。 Anyidea如何实现这个任务？
我可以想到为什么它失败的原因可能是每次保存文件时触发，但不应该Application.EnableEvents = False停止它的发生？ “
编辑＃1：
我尝试通过代码进入Not Responding State代码后通过End Sub线
FileCopy可能在这里很有用，因为你不关心覆盖数据，我认为这将节省你的循环保存状态（因为Filesystem对象将负责理想的解决networking延迟）。 我会改变逻辑：
1.保存此工作簿
2.覆盖我想要的位置
3.用户保留在原始工作簿中，因为您只保存此工作簿的副本。
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim FileSystemLibrary As Variant: Set FileSystemLibrary = CreateObject("Scripting.FileSystemObject") Dim thisPath As String: thisPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name Dim oneDrivePath As String: oneDrivePath = "C:\Users\Folder\OneDrive\" & ThisWorkbook.Name Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False ThisWorkbook.Save FileSystemLibrary.CopyFile FileSystemLibrary.GetFile(thisPath), oneDrivePath Application.DisplayAlerts = True Application.EnableEvents = True Application.ScreenUpdating = True End Sub
如果你所做的一切都是保存的，你不需要循环。 尝试下面
Sub save() pathForFirstSave = "C:\folder1\" pathForSecondSave = "C:\anotherFolder\" ActiveWorkbook.SaveAs Filename:=pathForFirstSave & "asdf.xlsx" _ , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ActiveWorkbook.SaveAs Filename:=pathForSecondSave & "asdf.xlsx" _ , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False End Sub