[發問] 存檔時自動備份檔案並轉為.xlsx格式

msmplay

不好意思想請問一下，我想打開一份有巨集的excel檔後，在檔案儲存時能同步自動備份檔案到「備份」資料夾
且檔案格式要轉為.xlsx，但我測試以下代碼後，自動備份檔案到「備份」資料夾有成功，但打開檔案時卻出現以下視窗而且完全打不開

下載 (13.13 KB)

2016-8-20 01:17

想請問以下代碼是否有誤或該如何修正呢!?非常感謝~~~~~~~

thisworkbook，代碼：
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Dim mypath As String, fname As String
fname = "自動備份" & Format(Date, "yymmdd") & ".xlsx"
mypath = ThisWorkbook.Path & "/備份/"
ThisWorkbook.SaveCopyAs mypath & fname
End Sub

lpk187

回復 1# msmplay

1. Private Sub Workbook_BeforeClose(Cancel As Boolean)
   
2. Dim mypath As String, fname As String
   
3. fname = "自動備份" & Format(Date, "yymmdd") & ".xlsx"
   
4. mypath = ThisWorkbook.Path & "\備份\"
   
5. ThisWorkbook.SaveAs mypath & fname, FileFormat:=xlOpenXMLWorkbook
   
6. End Sub

複製代碼

zyzzyva

回復 1# msmplay
SaveCopyAs好像沒辦法指定格式。沒想到更好的辦法，這個試試看。

1. Private Sub Workbook_BeforeClose(Cancel As Boolean)
   
2.     On Error Resume Next
   
3.     Dim mypath As String, fname As String
   
4.    
   
5.     If Me.Saved = True Then
   
6.         fname = "自動備份" & Format(Date, "yymmdd")
   
7.         mypath = ThisWorkbook.Path & "/備份/"
   
8.         ThisWorkbook.SaveCopyAs mypath & fname & ".xlsm"
   
9.         
   
10.         Workbooks.Open (mypath & fname & ".xlsm")
    
11.         Application.DisplayAlerts = False
    
12.         ActiveWorkbook.SaveAs mypath & fname, FileFormat:=51
    
13.         Application.DisplayAlerts = True
    
14.         ActiveWorkbook.Close
    
15.         Kill (mypath & fname & ".xlsm")
    
16.     End If
    
17.    
    
18. End Sub

複製代碼

msmplay

回復 2# lpk187

   l大~~~~非常感謝幫忙，不過小妹測試之後原檔出現以下錯誤訊息，可以再請您幫忙看看嗎~~~~

下載 (33.77 KB)

2016-8-21 00:27

下載 (20.21 KB)

2016-8-21 00:27

下載 (7.15 KB)

2016-8-21 00:27

zyzzyva

3F的code有點bug，一定要先存檔再關閉才有用，如果是在對話視窗出來再按「是」存檔就不會作用。
應該是事件觸發先後的問題，要再修改一下。

msmplay

回復 3# zyzzyva

z大~~~~~您又出手相助了!!!非常感謝喔~~~~~
不過測試之後，雖然已經按過存檔，但只要關閉檔案時還是會再出現一次以下的訊息視窗，請問是否可跳過此對話視窗呢!?

下載 (20.98 KB)

2016-8-21 00:36

zyzzyva

回復 6# msmplay
怪怪，我用空白的測沒有這個問題，可以先在kill下一行加個ActiveWorkbook.Save，bug明天有空再研究。

lpk187

回復 4# msmplay

1. Private Sub Workbook_BeforeClose(Cancel As Boolean)
   
2. Dim mypath As String, fname As String
   
3. fname = "自動備份" & Format(Date, "yymmdd") & ".xlsx"
   
4. mypath = ThisWorkbook.Path & "\備份\"
   
5. Application.DisplayAlerts = False '關閉系統警告訊息
   
6. ThisWorkbook.Save '要儲存自身檔案，請自行選擇要不要儲存
   
7. ThisWorkbook.SaveAs mypath & fname, FileFormat:=xlOpenXMLWorkbook
   
8. Application.DisplayAlerts = True '開啟系統警告訊息
   
9. End Sub

複製代碼

c_c_lai

回復 6# msmplay
原因非常明顯，有巨集的的活頁簿檔案，
如存成 .xlsx 型態，其巨集會隨之消失的。

zyzzyva

回復 6# msmplay
後來想了一下，如果沒有一定要用SaveCopyAs的原因，用l大的方式直接SaveAs比較好。
不過最好還是加個if判斷，不然如果關閉的時候選否，備份還是會執行，原來正確的備份就被蓋掉了。
拿網路上跟l大的code組合改了一下，您再參考看看。

1. Private Sub Workbook_BeforeClose(Cancel As Boolean)
   
2.     Dim mypath As String, fname As String
   
3. 
   
4.     If Not Me.Saved Then
   
5.         Msg = "Do you want to save the changes you made to "
   
6.         Msg = Msg & Me.Name & "?"
   
7.         Ans = MsgBox(Msg, vbQuestion + vbYesNoCancel)
   
8.         Select Case Ans
   
9.             Case vbYes
   
10.                 Me.Save
    
11.             Case vbNo
    
12.                 Me.Saved = False
    
13.             Case vbCancel
    
14.                 Cancel = True
    
15.                 Exit Sub
    
16.           End Select
    
17.     End If
    
18.    
    
19.     If Me.Saved Then
    
20.         Application.DisplayAlerts = False '關閉系統警告訊息
    
21.         fname = "自動備份" & Format(Date, "yymmdd") & ".xlsx"
    
22.         mypath = ThisWorkbook.Path & "\備份\"
    
23.         'ThisWorkbook.Save '要儲存自身檔案，請自行選擇要不要儲存
    
24.         ThisWorkbook.SaveAs mypath & fname, FileFormat:=xlOpenXMLWorkbook
    
25.         Application.DisplayAlerts = True '開啟系統警告訊息
    
26.     Else
    
27.         Me.Saved = True
    
28.     End If
    
29.       
    
30. End Sub

複製代碼