通过VBA提取文件夹下边所有文件信息
1、新建一个Excel工作表后打开，再按下【Alt+F11】组合键调出VBE编辑器。
2、点击【插入】、【模块】。
3、在模块的代码框里面输入以下VBA程序：
Sub Getfiles_All_Name()
Dim x1, x2, x3, x4, x5, arr
On Error Resume Next '忽略运行过程中可能出现的错误
Application.ScreenUpdating = False '关闭显示更新，提高运行速度
x1 = 2 '从第2行开始
Set mysheet1 = ThisWorkbook.Worksheets("Sheet1") '定义Sheet1
Set fs = CreateObject("Scripting.FileSystemObject") '访问计算机文件
mysheet1.Cells(x1, 1) = "D:\ABCD" '查找该文件夹《ABCD》下面所有的文件
For x2 = 2 To 1000000 '预计的文件夹数量
If mysheet1.Cells(x2, 1) <> "" Then
Set fo = fs.getfolder(mysheet1.Cells(x2, 1)) '该路径下的文件夹
For Each fd In fo.subfolders '获取该文件夹下面所有的子文件夹
x1 = x1 + 1
arr = Array(fd.Path, fd.Name, fd.Type, fd.DateCreated, fd.DateLastModified, fd.Size)
'获取文件路径、名称、类型、创建时间、最后修改时间、大小
For x5 = 0 To 5
mysheet1.Cells(x1, x5 + 1) = arr(x5) '逐一写入单元格
Next
Next
Else
Exit For '退出For循环
End If
Next
x4 = x1
For x3 = 2 To x4
Set fo = fs.getfolder(mysheet1.Cells(x3, 1))
Set fi = fo.Files
For Each fe In fi '获取该文件夹下面所有的子文件
x1 = x1 + 1
arr = Array(fe.Path, fe.Name, fe.Type, fe.DateCreated, fe.DateLastModified, fe.Size)
For x5 = 0 To 5
mysheet1.Cells(x1, x5 + 1) = arr(x5)
Next
Next
Next
Application.ScreenUpdating = True '恢复显示更新
End Sub
4、检查无误后，在功能区里面点击“运行”图标运行程序。（或者按下【F5】键运行程序）
5、稍等片刻，将会在Excel工作表上面看到要提取的相关信息。（主要与文件夹下面的文件数量有关）
1、（1）“For Each……In……Next”虽然可以通过subfolders获取子文件夹信息，但子文件夹里面的文件夹及相关信息又无法获取。
（2）既然不能通过“For Each……In……Next”提取所有信息，可以先提取文件夹的相关信息，再通过文件夹信息提取内部信息。
（3）结合“For……To……Next”使用数组函数Array可以简化一些程序。
