已有一组Excel表格数据,使用VBA快速批量建文件夹
不知道标题怎么写。
已经有了这样一组数据
然后需要根据这两组数据新建文件夹,代码如下
Sub 建文件夹()
Dim i As Integer '用于下方数组
Dim Arr1(), Arr2() '定义一个数组,不能定义大小和类型
Dim Fso, Fld '定义文件路径
Dim rowmax '找到数据的行数
start_time = Timer '计时开始
'数据的行数
rowmax = [A1048576].End(xlUp).Row
'把两列数据分别赋值给两个个数组
Arr1 = Range("A2:A" & rowmax)
Arr2 = Range("B2:B" & rowmax)
'选择建文件夹的路径
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fld = Fso.getfolder(CreateObject("Shell.Application").BrowseForFolder(0, "请选择需要创建文件夹的根目录", 0, "").Self.Path & "")
'开始批量新建文件夹
For i = 1 To UBound(Arr1)
FolderName = Arr1(i, 1) & " " & Arr2(i, 1)
If Dir(Fld & "\" & FolderName, vbDirectory) = vbNullString Then '如果文件夹不存在,则新建
VBA.MkDir (Fld & "\" & FolderName)
End If
Next
'建好了
cost_time = Timer - start_time '计时结束,计算用时
Range("D6") = cost_time
End Sub
完成
- 202003072230 更新
如果是需要建二级目录,在第一次for循环里再加一个for循环即可,如下图所示。
Sub 建文件夹()
Dim i As Integer '用于下方数组
Dim Arr1(), Arr2() '定义一个数组,不能定义大小和类型
Dim Fso, Fld '定义文件路径
Dim rowmax '找到数据的行数
start_time = Timer '计时开始
'数据的行数
rowmax = [A1048576].End(xlUp).Row
'把两列数据分别赋值给两个个数组
Arr1 = Range("A2:A" & rowmax)
Arr2 = Range("B2:B" & rowmax)
'选择建文件夹的路径
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fld = Fso.getfolder(CreateObject("Shell.Application").BrowseForFolder(0, "请选择需要创建文件夹的根目录", 0, "").Self.Path & "")
'开始批量新建文件夹
For i = 1 To UBound(Arr1)
FolderName = Arr1(i, 1) & " " & Arr2(i, 1)
If Dir(Fld & "\" & FolderName, vbDirectory) = vbNullString Then '如果文件夹不存在,则新建
VBA.MkDir (Fld & "\" & FolderName) ' 新文件建好了
' 见上方的一行代码,此时,已经建好了一个文件夹。文件夹的全路径是:Fld & "\" & FolderName
' 如果需要建二级文件夹的话,在已经建好的文件夹下继续新建文件夹就行了
'''''''''''''''''''''''''''''以下''''''''''''''''''''''''''''''''''''''''''''
' 下方For循环模拟建二级文件夹
For j = 0 To 10
VBA.MkDir (Fld & "\" & FolderName & "\" & "测试文件" & j)
Next
'''''''''''''''''''''''''''''以上''''''''''''''''''''''''''''''''''''''''''''
End If
Next
'建好了
cost_time = Timer - start_time '计时结束,计算用时
Range("D6") = cost_time
End Sub
- 这里操作
'''''''''''''''''''''''''''''以下''''''''''''''''''''''''''''''''''''''''''''
' 下方For循环模拟建二级文件夹
For j = 0 To 10
VBA.MkDir (Fld & "\" & FolderName & "\" & "测试文件" & j)
Next
'''''''''''''''''''''''''''''以上''''''''''''''''''''''''''''''''''''''''''''
最后效果如下图所示
一级目录
二级目录