[發問] 如何快速建立空白資料夾

luke

各位大大

小弟碰到建立資料夾問題, 我想使用兩個按鈕控制分別去建立單個或多個資料夾於桌面上(如附檔說明)

煩請先進指導
TEST6.rar (15.05 KB)

下載次數: 7

2012-4-5 09:54

Hsieh

回復 1# luke

1. Sub ex()
   
2. Set fdo = CreateObject("Scripting.FileSystemObject")
   
3. fd = "C:\Documents and Settings\User\桌面\"  '桌面路徑
   
4. Set a = Columns("A").Find([B1], lookat:=xlWhole)
   
5. If Not a Is Nothing Then
   
6. fs = fd & Join(Application.Transpose(Application.Transpose(a.Offset(, 1).Resize(, 3))), "-") & "-" & Format(Date, "yyyymmdd") & "\"
   
7. If fdo.folderexists(fs) = False Then MkDir fs
   
8. End If
   
9. End Sub

複製代碼

GBKEE

回復 1# luke

1. Option Explicit
   
2. Sub 建立()
   
3.     Dim Rng As Range, xF As Variant, xlDesktop As String
   
4.     Set Rng = Range("A7:A" & [A7].End(xlDown).Row)
   
5.     Set xF = Rng.Find([b1], lookat:=xlWhole)
   
6.      If xF Is Nothing Then Exit Sub
   
7.     xF = Application.Transpose(Application.Transpose(Cells(xF.Row, "a").Resize(, 3).Value))
   
8.     xF = Join(xF, "-") & "-" & Format(Date, "yymmdd")
   
9.     xlDesktop = Get_Desktop
   
10.     If Dir(xlDesktop & xF, 16) = "" Then MkDir (xlDesktop & xF)  '
    
11. End Sub
    
12. Sub 全選()
    
13.     Dim E As Range, xF As Variant, xlDesktop As String
    
14.      xlDesktop = Get_Desktop
    
15.      For Each E In Range("A7:A" & [A7].End(xlDown).Row)
    
16.         xF = Application.Transpose(Application.Transpose(Cells(E.Row, "a").Resize(, 3).Value))
    
17.         xF = Join(xF, "-") & "-" & Format(Date, "yymmdd")
    
18.         If Dir(xlDesktop & xF, 16) = "" Then MkDir (xlDesktop & xF)
    
19.     Next
    
20. End Sub
    
21. Private Function Get_Desktop() As String  '函數 : 傳回所在電腦的桌面路徑
    
22.     Dim ob As Object
    
23.     Set ob = CreateObject("Wscript.Shell")
    
24.     Get_Desktop = ob.SpecialFolders("Desktop") & "\"
    
25. End Function

複製代碼

luke

回復 2# Hsieh


    建立單個資料夾測試OK

    謝謝H大

luke

回復 4# luke

     按鈕測試建立單/多個資料夾OK
   
    謝謝GBKEE版大