将excel文件保存在两个不同的位置

Question

每当我保存 excel 文件时，我都必须这样做：

1. 将文件保存在一个驱动器位置（如果存在同名文件，则覆盖）

2. 返回文件的原始位置并保存（覆盖文件）

代码：

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 进入无响应状态。知道如何完成这项任务吗？

我能想到它失败的原因可能是每次保存文件时都会触发它，但 Application.EnableEvents = False 不应该阻止它发生吗？ '

编辑#1：

在代码通过End Sub 行后，我尝试单步执行进入Not Responding State 的代码

Answer 1

FileCopy 在这里可能很有用，因为您不关心覆盖数据，我认为这可以为您节省保存状态的循环（因为 Filesystem Object 会理想地解决网络延迟问题）。我将逻辑更改为：
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

Answer 2

如果您所做的只是保存，则无需循环。试试下面的

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