Excel / 如何批次新增檔案資料夾-VBA +Excel 資料表 修改版

Excel / 如何批次新增檔案資料夾-VBA +Excel 資料表 修改版

Post Views: 2,679

這是 Excel / 如何批次新增檔案資料夾-VBA +Excel 資料表 的修改版

因為是有人從粉絲頁傳訊息給我 

問怎麼改成在不同電腦，不需要修改路徑，也可以使用  

所以也順便更新紀錄在這裡

原始版本是在自己的電腦上執行

因此路徑都是固定的

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
 
Public Sub 新增檔案資料夾()

  r = Worksheets(1).Range("A1").End(xlDown).Row
  
  out_path = "C:\Users\trico\Desktop\123\"
    For i = 2 To r
        n = Range("A" & i)
        c = Range("B" & i)
        s = Range("C" & i)
        
        file_name = n & "-" & c & "-" & s
            MkDir out_path & file_name
    
    Next
    
End Sub

 

如果要改成變動的路徑

就需要抓取電腦的桌面資料夾路徑

這可以透過  Environ( “USERPROFILE“) 函式來取得當前電腦的使用者資料夾 C:\Users\xxx

再配合字串連結 \Desktop 就可以產生當前使用者的桌面資料夾路徑

以下是修改後的程式碼

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Public Sub 新增資料夾2()

  r = Worksheets(1).Range("A1").End(xlDown).Row
  
  filepath = Environ("USERPROFILE")
  
  MkDir filepath & "\Desktop\Create Folder"
  
  Application.Wait (Now + TimeValue("00:00:01"))
  
  out_path = filepath & "\Desktop\Create Folder\"

    For i = 2 To r
        n = Range("A" & i)
        c = Range("B" & i).Value
'        s = Range("C" & i)
        
'        fiel_name = n & "-" & c & "-" & s
        file_name = n & " - " & c
            MkDir out_path & file_name
    
    Next
    
End Sub

也增加了一些新的設定

例如：

#7 直接產生存放新增資料夾的資料夾

#9 讓程式暫停1秒，避免程式出錯

之後，可以再進一步優化程式碼

例如增加判斷式，來判斷是否已經有重複的資料夾

 

參考資料

Environ 函數

環境變數 (Environment Variable)

Tags: ,