Board logo

標題: 另存新檔問題 [打印本頁]
作者: enoch    時間: 2012-6-27 15:12     標題: 另存新檔問題

使用 ActiveWorkbook.SaveAs Filename:=newfilename 另存新檔時
若檔案已存在, 會出現警告視窗, 是否取代現有檔案
當選擇不取代現有檔案, 即出現錯誤

請問應如何修改程式, 可選擇取消不儲存, 或更改檔案名稱另存新檔

另外, 若想直接取代舊檔案,  不顯示警告, 又應該如何

請指教
作者: kimbal    時間: 2012-6-28 13:34

本帖最後由 kimbal 於 2012-6-28 13:39 編輯

找出檔案是不是已經存在,存在的話,把檔名加上時間存起來. (例如c:\abc20120628133801.xls)
  1. Dim strExist As String
  2. dim strFolder as string
  3. dim strFilename as string
  4. strFolder = "c:\"
  5. strFilename="abc"
  6. strExist = Dir(strFolder & strFilename & ".xls")
  7. If strExist = "" Then
  8.    ActiveWorkbook.SaveAs Filename:=strFolder & newfilename & ".xls"
  9. else
  10.    ActiveWorkbook.SaveAs Filename:=strFolder & newfilename & format(now(),"yyyymmddhhmmss") & ".xls"
  11. End If
複製代碼
直接取代 (把提示停掉)
  1. application.displayalerts=false
  2. ActiveWorkbook.SaveAs Filename:=newfilename
  3. application.displayalerts=true
複製代碼
作者: enoch    時間: 2012-6-28 15:57

本帖最後由 enoch 於 2012-6-28 16:20 編輯

謝謝 kimbal 指教, 我試到另外方法, 想分享一下



On Error Resume Next
ActiveWorkbook.SaveAs Filename:="book1"

If Err <> 0 Then '取消另存新檔時顯示
Application.Dialogs(xlDialogSaveAs).Show
作者: GBKEE    時間: 2012-6-28 16:42

回復 3# enoch
On Error Resume Next  除非確定錯誤點可忽略 ,否則不輕易使用
  1. Option Explicit
  2. Sub Ex()
  3.     Dim xlMsg As String, Newfilename As String, xlSave As Integer
  4.     Newfilename = "D:\TEST.XLS"
  5.     xlMsg = IIf(Dir(Newfilename) <> "", "覆蓋檔案", "儲存檔案")
  6.     xlSave = MsgBox(Newfilename & Chr(10) & xlMsg & ":是(Y), 另存檔案:否(N),不存檔案:取消", vbYesNoCancel)
  7.     'xlSave 傳回 vbYes, vbNo , vbCancel 三選一
  8.     Application.DisplayAlerts = False
  9.     If xlSave = vbYes Then
  10.         ActiveWorkbook.SaveAs Filename:=Newfilename
  11.     ElseIf xlSave = vbNo Then
  12.         With Application.FileDialog(msoFileDialogSaveAs)
  13.             .InitialFileName = Newfilename
  14.             If .Show = -1 Then ActiveWorkbook.SaveAs Filename:=.SelectedItems(1)
  15.         End With
  16.     End If
  17.     Application.DisplayAlerts = True
  18. End Sub
複製代碼
作者: enoch    時間: 2012-6-29 10:35

本帖最後由 enoch 於 2012-6-29 12:46 編輯

多謝GBKEE , 真的教了我很多

Application.FileDialog 比 Application.Dialogs
更加好用, 可以加上引數, 預先設定檔案名稱等資料

因為有時想不到其它方法,  才會用
On Error Resume Next

若用完之後即時加上
On error goto 0  可以嗎


試完程過, 但有少少問題想再請教
如何控制是OFFICE 03 ".XLS" 檔案呢?
因為程式可能在不同EXCEL版本中使用
雖然明稱是TEST.XLS , 但檔案類型都可能轉了其它版本
作者: GBKEE    時間: 2012-6-29 12:49

回復 5# enoch
程式上 是可以如此的
作者: enoch    時間: 2012-6-29 14:37

但試過若執行程式前, 更改過儲存檔案的類型,
例如之前執行過檔案>>另存新檔>>選擇存檔類型為".CSV"
執行程式時就算檔案後面是".XLS" 尾, 都會更改了".CSV"
作者: sillykin    時間: 2016-2-25 00:49

回復 4# GBKEE


    不好意思能請問
Ａ是原檔案，在這Ａ檔案中執行『另存新檔』，產生Ｂ檔案．．以此類推．．
要問的問題是：在Ａ檔案另存新檔後(產生２檔案)，能停留在Ａ檔案嗎？（因每次『另存新檔』後，工作均停留在每次產生新檔案）要如何停留在Ａ的原檔案呢？？
作者: GBKEE    時間: 2016-2-25 06:21

回復 8# sillykin
  1. SaveCopyAs 方法  將指定活頁簿的備份儲存到檔案，但不變更記憶體中已開啟的活頁簿。
複製代碼
  1. Sub Ex()
  2.     With ThisWorkbook
  3.        .SaveCopyAs .Path & "\test.xls"   '
  4.     End With
  5. End Sub
複製代碼
作者: sillykin    時間: 2016-7-3 21:01

Dim xPath As String
Dim Arr As Variant

Arr = Array("申請書", "契約書")
Sheets(Arr).Copy

ActiveWorkbook.SaveCopyAs Filename:= _
      "C:\" & TextBox1 & "(" & (Year(Date) & Month(Date)) & Day(Date) & ")" & "(" & TextBox2 & ")" & ".xlsm"
ActiveWorkbook.Close


       Unload Me
想請問為何執行上述程式，為另存二個sheet ,並存為一個新檔，但會多出一個新的檔案，小弟是否有地方用錯呢？？？？



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)