多级文件夹批量新建

jianwei1115

求大神帮忙做一个宏，实现多级文件夹批量新建，例如输入A   B        C   
1  1. 1   1.1.1
    1.2    1.2.1

十分困扰啊

xinjiana

完全看不懂你在说什么

百度不到去谷歌

结合sql比较方便

1. Function SqlToArr(sql$)    '查询结果到数组,通用函数 其他地方调用也极其方便,建议收藏
   
2.     Dim cnn As Object    'New ADODB.Connection
   
3.     Dim rs As Object, arr   'New ADODB.Recordset
   
4.     Set cnn = CreateObject("adodb.connection")
   
5.     cnn.Open "Provider = Microsoft.Jet.Oledb.4.0;Extended Properties ='Excel 8.0';Data Source =" & ThisWorkbook.FullName
   
6.     On Error Resume Next
   
7.     Set rs = cnn.Execute(sql)
   
8.     SqlToArr = rs.GetRows '注意行列与excle是反的
   
9. End Function
   
10. 
    
11. Public Sub 批量创建文件夹()
    
12.     Dim sql$, arr, p$, i&, j&, k&, s$
    
13.     s = "SELECT distinct key1 from [Sheet1$] where not key2 is null"
    
14.     For i = 1 To 3 '3列可更改
    
15.         p = Sheet1.Cells(1, i)
    
16.         sql = Replace(s, "key2", p) '构造当前级不为空条件
    
17.         For k = i - 1 To 1 Step -1 '构建完整目录字符串
    
18.             p = Sheet1.Cells(1, k) & " & '\' & " & p
    
19.         Next
    
20.         sql = Replace(sql, "key1", p) '构造当前级全路径
    
21.         Debug.Print sql
    
22.         arr = SqlToArr(sql)
    
23.         For j = 0 To UBound(arr, 2)
    
24.             MkDir ThisWorkbook.Path & "" & arr(0, j) '建立文件夹
    
25.         Next
    
26.     Next
    
27. End Sub

复制代码

D批量建立多级文件夹批量1.rar (15.24 KB, 下载次数: 126)

2014-4-15 21:07 上传

点击文件名下载附件

jianwei1115

大牛啊，非常 感谢

luckcsz

百度不到去谷歌 发表于 2014-4-15 21:02
结合sql比较方便

您好~！这代码如何加选项窗口输入EXCEL名称就能制作，多表格制作，麻烦您写下代码，谢谢~~！