標題: [發問] VBA另存新檔出錯 [打印本頁]

---

作者: missbb    時間: 2024-1-27 01:39     標題: VBA另存新檔出錯

我有一個EXCEL檔案, 內有兩個工作表, 每個工作表都使用快捷按鈕執行下列的VBA CODE, 將工作表按指定路徑另存新檔案.

問題(1) 是有些時候執行VBA CODE時, 會顯示另存檔已經存在, 但其實會在指定路徑內, 自動增加了一何"PATH"的FOLDER, 再在FOLDER 內另存名稱是"FILENAME"的工作表.  不知是否兩個工作表共用一個VBA CODE出現問題? 希望賜教!
問題(2) 如果另存新檔案時, 已有相同名稱檔案存在,可否要取消存檔, 改為仍然存檔, 但自行在檔案名稱後加上V1, V2, V3等, 如此類推?

1. Sub activeSave_2c()
   
2. 
   
3. Application.ScreenUpdating = False
   
4. Dim filename As String, fPath As String
   
5. filename = [S2]: fPath = [S3]: If Dir(fPath, vbDirectory) = "" Then MkDir fPath
   
6. 
   
7. If Dir(fPath & "\" & filename & ".xlsx") <> "" Then
   
8.    MsgBox "指定的 " & filename & ".xlsx 已經存在! 沒有執行存檔": Exit Sub
   
9. End If
   
10. 
    
11. ActiveSheet.Copy
    
12. [A1:G100].Value = [A1:G100].Value
    
13. [H:Y].Delete: [A1].Select
    
14. ActiveWorkbook.SaveAs filename:=fPath & "\" & filename & ".xlsx"
    
15. ActiveWorkbook.Close
    
16. MsgBox "已經新增檔案": ThisWorkbook.Activate
    
17. End Sub

複製代碼

---

作者: 准提部林    時間: 2024-1-27 11:22

Sub activeSave_2c()
Dim filename As String, fPath As String,k%, km$
Application.ScreenUpdating = False
filename = [S2]: fPath = [S3]
If Dir(fPath, vbDirectory) = "" Then MkDir fPath

for k = 99 to 1 step -1
     km="_V" & format(k, "00")
     If Dir(fPath & "\" & filename & km & ".xlsx") <> "" Then exit for
next k
if k>=99 then msgbox "檔案序號已用完!!  ":exit sub
km="_V" & format(k+1, "00")

ActiveSheet.Copy
[A1:G100].Value = [A1:G100].Value
[H:Y].Delete: [A1].Select
ActiveWorkbook.SaveAs filename:=fPath & "\" & filename & km & ".xlsx"
ActiveWorkbook.Close
MsgBox "已經新增檔案": ThisWorkbook.Activate

---

作者: 准提部林    時間: 2024-1-27 11:27

檔名+日期時間//更符合分次建檔

Sub activeSave_3c()
Dim filename As String, fPath As String,k%, km$
Application.ScreenUpdating = False
filename = [S2]: fPath = [S3]
If Dir(fPath, vbDirectory) = "" Then MkDir fPath

km="_V" & format(now, "yymmdd-hhmmss")

ActiveSheet.Copy
[A1:G100].Value = [A1:G100].Value
[H:Y].Delete: [A1].Select
ActiveWorkbook.SaveAs filename:=fPath & "\" & filename & km & ".xlsx"
ActiveWorkbook.Close
MsgBox "已經新增檔案": ThisWorkbook.Activate

---

作者: missbb    時間: 2024-1-29 19:59

回復 3# 准提部林


   多謝指導:)

---

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