应用场景 快速对指定文件夹的文件创建目录(提取文件名),如果文件夹中包含子文件夹,则深度提取 知识要点 1:Application.FileDialog(msoFileDialogFolderPicker) 打开选择文件的对话框 2:FileDialog.Show 方法 显示文件对话框并返回一个 Long 类型的值,指示用户按下的是“操作”按钮 (-1) 还是“取消”按钮 (0) 3:vbDirectory 目录或文件夹 4:GetAttr 函数 返回一个 Integer,此为一个文件、目录、或文件夹的属性 5:ReDim Preserve 当改变原有数组最末维的大小时,使用此关键字可以保持数组中原来的数据 6:FileLen 返回一个 Long,代表一个文件的长度,单位是字节。 7:程序的重点在于递归,当getattr函数判断出当前对象是文件夹时,调用程序自身再次进行文件搜索 Dim arr(), i '声明公共变量,供两个过程调用 Sub 提取文件清单() Dim fd As Object, pathstr As String Set fd = Application.FileDialog(msoFileDialogFolderPicker) '打开选择文件的对话框 With fd '如果选择了目录则提取目录的路径,否则退出程序 If .Show = -1 Then pathstr = .SelectedItems(1) Else Exit Sub End With If Right(pathstr, 1) <> '\' Then pathstr = pathstr & '\' '如果路径右边没有'\'则追加一个 Cells.Clear '清除所有单元格的数据 Application.ScreenUpdating = False '关闭屏幕更新 i = 0 Call 查找(pathstr) '执行查找程序 '如果找到文件,则所有数组的值导入到单元格中,数组中包括所有找到的文件 If i > 0 Then [a2].Resize(i, 3) = WorksheetFunction.Transpose(arr) [a1:c1].EntireColumn.AutoFit '按字符自动调整宽度 Application.ScreenUpdating = True '恢复屏幕更新 End Sub Public Sub 查找(ByVal 路径 As String) '查找文件过程 Dim dirs() As String, dir_count As Long, file_name As String, file_name_2 As String, j If Right(路径, 1) <> '\' Then 路径 = 路径 & '\' '如果路径最后一位非'\'则追加一个'\' file_name = Dir(路径 & '*.*', vbDirectory) '获取文件目录名称 Do While Len(file_name) <> 0 '只要文件目录名存在(目录字符长度大于0)就循环下去 If Left$(file_name, 1) <> '.' Then '如果左边第一字符不为'.' file_name_2 = 路径 & file_name '获取子目录 If (GetAttr(file_name_2) And vbDirectory) = vbDirectory Then '如果是文件夹 dir_count = dir_count 1 '计算子目录数量 ReDim Preserve dirs(1 To dir_count) As String '重新声明数组的存储控件 dirs(dir_count) = file_name_2 '将子目录名称写入到数组dirs中 Else '如果不是文件夹目录 i = i 1 ReDim Preserve arr(1 To 3, 1 To i) '重新声明数组的存储空间 arr(1, i) = 路径 '将文件路径写入数组 arr(2, i) = file_name '将文件名写入数组 arr(3, i) = FileLen(路径 & file_name) / 1024 / 1024 '将文件大小写入数组 End If End If file_name = Dir() '查找下一个文件 Loop For j = 1 To dir_count '遍历数组dirs ,即对子目录进行查找 查找 dirs(j) '调用自身再执行文件擦在 Next j End Sub |
|
来自: L罗乐 > 《VBA基础入门教程》