保存時將.xlsm的副本創建為.xlsx

Question

我正在嘗試創建工作簿.xlsm的備份副本並將其另存為.xlsx

由於與此處相同的問題： 運行時錯誤'1004'：工作表類的復制方法失敗-臨時文件問題我不能同時使用SaveCopyAs和更改文件格式

我的解決方法是

1. 創建.xlsm文件的新副本
2. 打開這個新副本
3. 將其另存為.xlsx
4. 關閉.xlsx文件
5. 從步驟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'：對象變量或在調試中未設置塊變量的情況下，它指向帶有代碼的行

wkb.Activate

和.xlsm文件不會被刪除

我猜問題是當我創建xlsm文件的新副本並將其保存時，整個代碼將再執行一次，並且該問題在某處，但是我找不到它。 謝謝

Answer 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

干杯，

喬納森