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

目前遇到一個另存新檔問題想請教各位老師
我新增一個資料夾檔名為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

文章關鍵字

Excel VBA 問題

misser

395分

2樓

misser

個人積分：395分

文章編號：78874472

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

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

小惡魔新聞台

今日熱門文章 網友點擊推薦！

今日熱門文章　網友點擊推薦！