【已解決】EXCEL VBA 另存新檔問題

whitejason05
個人積分：0分
文章編號：78111453

0分

樓主

2020-06-27 18:35

目前遇到一個另存新檔問題想請教各位老師
我新增一個資料夾檔名為Range("E1")，Range("E1")裡面的字串不固定，新增完資料夾後會刪除
要另存新檔到此資料，請各位老師指導指要如何修改呢? 謝謝!


Sub TEST()

    p = Dir("C:\Users\white\OneDrive\桌面\TEST\" & ActiveSheet.Range("E1") & ", vbDirectory")
    On Error Resume Next
    If p = "" Then MkDir ("C:\Users\white\OneDrive\桌面\TEST\" & ActiveSheet.Range("E1"))
    Range("E1").ClearContents
    ActiveWorkbook.SaveAs

End Sub

2020-06-27 18:35 發佈

文章關鍵字 Excel VBA 問題

misser

misser
個人積分：395分
文章編號：78874472

395分

2樓

2020-08-29 14:20

whitejason05 wrote:
要另存新檔到此資料，請各位老師指導指要如何修改呢?

幫你修改如下：

Sub TEST()
    save_name = ActiveSheet.Name '檔案名稱，預設使用現有不更改
    save_path = "C:\Users\white\OneDrive\桌面\TEST\" & ActiveSheet.Range("E1")  '要將檔案新增到的資料夾位置
    
    p = Dir(save_path, vbDirectory) '檢查資料夾狀況
    On Error Resume Next
    
    If p = "" Then MkDir (ActiveSheet.Range("E1")) '若資料夾不存在就新增
    Range("E1").ClearContents '刪除資料夾資訊
    
    ActiveWorkbook.SaveAs Filename:=save_path & "\" & save_name, FileFormat:=xlExcel8  '存檔，xlExcel8是「xls」格式，可自行變更所需
    
    MsgBox "存檔完成。"
    
End Sub

提醒一下，你原本的 p = Dir("C:\Users\white\OneDrive\桌面\TEST\" & ActiveSheet.Range("E1") & ", vbDirectory") ，語法有錯。(連接組合的結果就有問題)

然後，這個 On Error Resume Next 要盡量慎用，因為發生錯誤時沒有提醒(直接進行下一行)，所以有錯你也不知是哪行錯誤，建議在設計修改階段，可以註解掉這行。(這樣測試時才會有錯誤提醒)~~或者不註解，但要另做錯誤的處理回饋(以便提醒使用者，哪裡出錯了)。

以上，提供你參考。

Der，misser1

從 APP 打開