ExcelVBA文件操作-选择文件夹（含子文件夹）获取所有文件列表

哆哆Excel

发布于 2023-09-09 10:46:22

1.6K0

ExcelVBA文件操作-选择文件夹（含子文件夹）获取所有文件列表

【回顾】

近期我们学习了

1.ExcelVBA-打开对话框取得文件夹路径2种方法

2.ExcelVBA文件操作-获得文件夹中的所有子文件夹

3.ExcelVBA文件操作-选择文件夹获取文件列表

到目前

我们已完成：1.先打开对话框2.选择文件夹3.获取文件夹4.得到文件夹（包含子文件夹）的路径5. 获取文件夹（不含子文件夹）内的文件列表

今天我们将解决问题是：

6. 获取文件夹（含子文件夹）内的文件列表

【问题】

选择文件夹（含子文件夹）获取所有文件列表

【解决思路】

第【1-3】步:可以用自定义函数（PS:此函数返回要进行是否为空的判断，如果为空要exit sub）

'打开对话框，选择，取得文件夹路径，返回stringFunction SelectGetFolder() '选择单一文件 With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = ThisWorkbook.Path If .Show = -1 Then 'FileDialog 对象的 Show 方法显示对话框，并且返回 -1（如果您按 OK）和 0（如果您按 Cancel）。' MsgBox "您选择的文件夹是：" & .SelectedItems(1) SelectGetFolder = .SelectedItems(1) Else SelectGetFolder = "" End If End WithEnd Function

第【4】步：得到文件夹（包含子文件夹）的路径

也可以用自定义函数（PS:返回的数组是以0为下标的）

'输入文件夹，返回数组=文件夹（含子文件夹）的路径Function GetAllFolderPath(sPath As String) Dim aRes, sarr, sDic, sFso, F, Mat Dim FileName$, n&, k& On Error Resume Next Set sDic = CreateObject("Scripting.Dictionary") Set sFso = CreateObject("Scripting.FileSystemObject") sDic(sPath) = "" Do sarr = sDic.keys For Each F In sFso.GetFolder(sarr(n)).SubFolders sDic(F.Path) = "" Next n = n + 1 Loop Until sDic.Count = n GetAllFolderPath = sDic.keysEnd Function

再把返回的文件夹路径for next传入到读取文件列表的函数，每次它会返回一个数组，

我们再在主程序新建一个【大数组】，把返回的数组一个一个读取出来，添加到【大数组】中就完成啦

读取文件列表也可以用自定义函数，如下

'输入文件夹，返回文件名列表（不包含子文件夹）Function GetFolderFiles(folderspec As String) Dim sfso As Object, sfld, sff, sffs Dim temparr, n As Long Set sfso = CreateObject("Scripting.FileSystemObject") Set sfld = sfso.GetFolder(folderspec) Set sffs = sfld.Files ReDim temparr(1 To 1) For Each sff In sffs n = n + 1 If n > UBound(temparr) Then ReDim Preserve temparr(1 To n) temparr(n) = sff.Path Next GetFolderFiles = temparrEnd Function

【全部代码】

Sub yhd_ExcelVBA_选择文件夹获取文件列表包括子文件夹() Dim FilePath As String, i As Long, k As Long Dim PathArr(), FileArr ReDim FileArr(1 To 1) Range("A2").Resize(10000, 2) = "" FilePath = SelectGetFolder() If FilePath = "" Then MsgBox "没选择，退了": Exit Sub PathArr = GetAllFolderPath(FilePath) Range("A2").Resize(UBound(PathArr), 1) = Application.Transpose(PathArr) For i = LBound(PathArr) To UBound(PathArr) crr = GetFolderFiles(PathArr(i)) For j = LBound(crr) To UBound(crr) k = k + 1 If k > UBound(FileArr) Then ReDim Preserve FileArr(1 To k) FileArr(k) = crr(j) Next j Next i Range("b2").Resize(UBound(FileArr), 1) = Application.Transpose(FileArr)End Sub '输入文件夹，返回数组=本文件夹的文件名列表（不包含子文件夹）Function GetFolderFiles(folderspec) Dim sFso As Object, sfld, sff, sffs Dim temparr, n As Long Set sFso = CreateObject("Scripting.FileSystemObject") Set sfld = sFso.GetFolder(folderspec) Set sffs = sfld.Files ReDim temparr(1 To 1) For Each sff In sffs n = n + 1 If n > UBound(temparr) Then ReDim Preserve temparr(1 To n) temparr(n) = sff.Path Next GetFolderFiles = temparrEnd Function '打开对话框，选择，取得文件夹路径，返回stringFunction SelectGetFolder() '选择单一文件 With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = ThisWorkbook.Path If .Show = -1 Then 'FileDialog 对象的 Show 方法显示对话框，并且返回 -1（如果您按 OK）和 0（如果您按 Cancel）。 ' MsgBox "您选择的文件夹是：" & .SelectedItems(1) SelectGetFolder = .SelectedItems(1) Else SelectGetFolder = "" End If End WithEnd Function '输入文件夹，返回数组=文件夹包含子文件夹列表Function GetAllFolderPath(sPath As String) Dim aRes, sarr, sDic, sFso, F, Mat Dim FileName$, n&, k& On Error Resume Next Set sDic = CreateObject("Scripting.Dictionary") Set sFso = CreateObject("Scripting.FileSystemObject") sDic(sPath) = "" Do sarr = sDic.keys For Each F In sFso.GetFolder(sarr(n)).SubFolders sDic(F.Path) = "" Next n = n + 1 Loop Until sDic.Count = n GetAllFolderPath = sDic.keysEnd Function

【效果】