[發問] VBA另存新檔出錯

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

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

Sub activeSave_2c()
Application.ScreenUpdating = False
Dim filename As String, fPath As String
filename = [S2]: fPath = [S3]: If Dir(fPath, vbDirectory) = "" Then MkDir fPath
If Dir(fPath & "\" & filename & ".xlsx") <> "" Then
MsgBox "指定的 " & filename & ".xlsx 已經存在! 沒有執行存檔": Exit Sub
End If
ActiveSheet.Copy
[A1:G100].Value = [A1:G100].Value
[H:Y].Delete: [A1].Select
ActiveWorkbook.SaveAs filename:=fPath & "\" & filename & ".xlsx"
ActiveWorkbook.Close
MsgBox "已經新增檔案": ThisWorkbook.Activate
End Sub

複製代碼

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2833
主題: 10
精華: 0
積分: 2889
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-12

2^#

發表於 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

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2833
主題: 10
精華: 0
積分: 2889
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-12

3^#

發表於 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

TOP

missbb

中學生 Rank: 2

帖子: 216
主題: 71
精華: 0
積分: 292
點名: 0
作業系統: window xp
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2012-6-27
最後登錄: 2024-9-28

4^#

發表於 2024-1-29 19:59 | 只看該作者

回復 3# 准提部林

多謝指導:)

TOP