Question

每当我保存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

但这并不适用于陷入infinte循环或Excel进入无响应状态。 Anyidea如何实现这一任务？

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

编辑＃1：

在代码获取Not Responding State行

End Sub

Answer 1

如果您所做的一切都在保存，那么您不需要循环。试试下面的

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

Answer 2

FileCopy在这里可能很有用，因为你不关心覆盖数据，我认为这可以节省你保存状态的循环（因为文件系统对象将负责理想地解决网络延迟）。我将逻辑改为：
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

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

2 个答案: