打开文件时将文件的副本保存在特定文件夹中

Posted 2023-05-07

【中文标题】打开文件时将文件的副本保存在特定文件夹中

【英文标题】：Save a copy of a file in a specific folder on opening the file

【发布时间】：2019-11-03 12:37:11

【问题描述】：

我有一个 Excel 工作簿，很多人都在使用，很容易被毁掉。

如何通过打开 Excel 工作簿（文件）自动将副本保存到特定文件夹？

Excel 工作簿位于 SharePoint 中，因此我可以在同一位置创建一个名为“存档”的新文件夹，并通过打开该文件创建一个具有相同名称的新副本 +“DD.MM.YYY HH: MM:SS" 将保存在这里。

【参考方案1】：

我不确定共享点，但如果文件保存在常规文件夹中，则此工作。可以通过不同的方式提出解决方案。

将代码保存在 VBA 编辑器中的以下位置。将 sub 命名为“Private Sub Workbook_Open()” - 表示 excel 在打开时应该执行代码。 当“程序”字段变为“打开”时，您可以看到您已经成功，图中标记为黄色。

备选方案 1：

在这里，我通过写"G:\Till\" 对我的路径进行硬编码。然后我继续添加时间戳并选择哪种格式。请注意，您不能在路径中使用 分号 ":"。一种方法是为时间添加“T”，然后添加小时+分钟+秒。 在我的示例代码中，结果将是：“数据示例 - 2019-11-03 T203533.xlsm”

请注意，如果路径不存在，此代码将收到错误 1004。

Private Sub Workbook_Open()
Dim Fldr As String
Application.DisplayAlerts = False 'Hide any save window pop-up
ActiveWorkbook.SaveCopyAs Filename:="G:\Till\" & "Data Example - " & Format(Now(), "yyyy-MM-dd Thhmmss") & ".xlsm" 'Save the workbook as a copy of the original. Add Hour and timestamp
Application.DisplayAlerts = True
End Sub

备选方案 2：

为了使代码更健壮，我检查了我使用的工作簿的路径，然后检查文件夹“存档”是否存在。如果它不存在，它将创建文件夹并保存文件的副本。

Private Sub Workbook_Open()
Dim Fldr As String
Application.DisplayAlerts = False 'Hide any save window pop-up
Fldr = Dir(Application.ActiveWorkbook.Path & "\Archive\", vbDirectory) 'Check if folder exists. The variable will be empty if no folder exists.

If Fldr = Empty Then 'If no folder exist, the variable "Folder"
    MkDir Application.ActiveWorkbook.Path & "\Archive\" 'Create the folder
End If

ActiveWorkbook.SaveCopyAs Filename:=Application.ActiveWorkbook.Path & "\Archive\" & "Data Example - " & Format(Now(), "yyyy-MM-dd Thhmmss") & ".xlsm"
Application.DisplayAlerts = True
End Sub