保存时将 .xlsm 的副本创建为 .xlsx

Posted 2023-05-07

【中文标题】保存时将 .xlsm 的副本创建为 .xlsx

【英文标题】：Create copy of .xlsm as .xlsx on save

【发布时间】：2018-03-12 11:34:41

【问题描述】：

我正在尝试创建工作簿 .xlsm 的备份副本并将其另存为 .xlsx

由于与此处相同的问题：Run time error '1004': Copy method of worksheet class failed - Temp file issue 我不能在更改文件格式的同时使用 SaveCopyAs

我的解决方法是

创建 .xlsm 文件的新副本 打开这个新副本 另存为 .xlsx 关闭 .xlsx 文件 从步骤 1 中删除文件

这是我的代码

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    On Error GoTo ErrorHandler:
    'define variables
    Dim backupfolder As String
    Dim strFileName As String
    Dim xlsxStrFileName As String
    Dim fullPath As String
    Dim xlsxFullPath As String
    Dim wkb As Workbook

    'get timestamp
    dt = Format(CStr(Now), "yyyymmdd_hhmmss")

    'construct full path to backup file which will be later converted to .xlsx
    backupfolder = "c:\work\excel macro\delete\"

    strFileName = "Test_iz_" & dt & ".xlsm"
    fullPath = "" & backupfolder & strFileName

    xlsxStrFileName = "Test_iz_" & dt & ".xlsx"
    xlsxFullPath = "" & backupfolder & xlsxStrFileName

    ActiveWorkbook.SaveCopyAs Filename:=fullPath

    Set wkb = Workbooks.Open(fullPath)

    wkb.Activate
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=xlsxFullPath, FileFormat:=51 'saves the file
    Application.DisplayAlerts = True
    'Application.Wait (Now + TimeValue("00:00:03"))
    ActiveWorkbook.Close
    Kill fullPath
    Exit Sub

ErrorHandler:
    MsgBox "An error occured " & vbNewLine & vbNewLine & Err.Number & ": " & Err.Description
    MsgBox "Backup saved: " & xlsxFullPath
    ActiveWorkbook.SaveAs Filename:=fullPath

End Sub

我的问题是我总是以 ErrorHandler 结束，即使我得到了预期的结果

当我注释掉第 2 行时

On Error GoTo ErrorHandler:

错误运行时错误'91'：对象变量或未设置块变量 在Debug上，它指向带有代码的行

wkb.Activate

并且 .xlsm 文件没有被删除

我想问题是当我创建 xlsm 文件的新副本并保存它时，整个代码将再执行一次，并且该问题存在于某个地方，但我找不到它。 谢谢

【问题讨论】：

尝试在保存备份副本的行之前添加Application.EnableEvents = False（记得将其设置回True）。

【参考方案1】：

这在我的电脑上有效：

Sub Workbook_BeforeSave()
On Error GoTo ErrorHandler:
'define variables
Dim backupfolder As String
Dim strFileName As String
Dim xlsxStrFileName As String
Dim fullPath As String
Dim xlsxFullPath As String
Dim wkb As Workbook

'get timestamp
dt = Format(CStr(Now), "yyyymmdd_hhmmss")

'construct full path to backup file which will be later converted to .xlsx
backupfolder = "c:\work\excel macro\delete\"

strFileName = "Test_iz_" & dt & ".xlsm"
fullPath = "" & backupfolder & strFileName

xlsxStrFileName = "Test_iz_" & dt & ".xlsx"
xlsxFullPath = "" & backupfolder & xlsxStrFileName

ActiveWorkbook.SaveAs Filename:=fullPath, FileFormat:=52
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=xlsxFullPath, FileFormat:=51 'saves the file
Application.DisplayAlerts = True
ActiveWorkbook.Close
Kill fullPath
Exit Sub
ErrorHandler:
MsgBox "An error occured " & vbNewLine & vbNewLine & Err.Number & ": " & Err.Description
MsgBox "Backup saved: " & xlsxFullPath
ActiveWorkbook.SaveAs Filename:=fullPath
End Sub

干杯，

乔纳森