返回列表 上一主題 發帖

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

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

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

擷取.PNG
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
*宅女一枚無誤*

回復 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
複製代碼

TOP

回復 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
複製代碼

TOP

回復 2# lpk187

   l大~~~~非常感謝幫忙,不過小妹測試之後原檔出現以下錯誤訊息,可以再請您幫忙看看嗎~~~~
擷取.PNG
2016-8-21 00:27


擷取1.PNG
2016-8-21 00:27


擷取2.PNG
2016-8-21 00:27
*宅女一枚無誤*

TOP

本帖最後由 zyzzyva 於 2016-8-21 00:40 編輯

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

TOP

回復 3# zyzzyva

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

擷取3.PNG
2016-8-21 00:36
*宅女一枚無誤*

TOP

本帖最後由 zyzzyva 於 2016-8-21 00:56 編輯

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

TOP

回復 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
複製代碼

TOP

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

TOP

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

TOP

        靜思自在 : 要比誰更受誰.不要比誰更怕誰。
返回列表 上一主題