1.ExcelVBA文件操作-选择文件夹(含子文件夹)获取所有文件列表
【问题】
前面的学习中,有几个自定义函数:1.运行不是那么优化,2.在实际应用中我们关注的是文件路径,对文件夹的路径不是那么关注今天进行优化:取自定义函数为:arr=GetAllFolderFiles(路径,参数)只获取文件的路径,添加了可选项,参数默认为0时,只读取本目录的文件列表,参数不等于0时,读取本目录(含子目录)的所有文件列表 |
---|
【两个自定义函数】
'打开对话框,选择,取得文件夹路径,返回string
Function 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 With
End Function
arr=GetAllFolderFiles(路径,参数) |
---|
'输入文件夹,返回数组=文件夹包含子文件夹列表
' 用法:arr=GetAllFolderFiles(路径,2)参数Ndir=1不包含子目录,Ndir>1包含子目录
Function GetAllFolderFiles(sPath As Variant, Optional Ndir As Long = 0)
Dim sDic As Object, sFso As Object, sFld As Object, sFiles As Object, F As Object
Dim n As Long, k As Long
Dim sf As Object, sk As Variant
Dim sResArr(), stempArr
' On Error Resume Next
Set sDic = CreateObject("Scripting.Dictionary")
Set sFso = CreateObject("Scripting.FileSystemObject")
sDic(sPath) = ""
If Ndir <> 0 Then
Do
stempArr = sDic.keys
For Each F In sFso.GetFolder(stempArr(n)).SubFolders
sDic(F.Path) = ""
Next
n = n + 1
Loop Until sDic.Count = n
End If
ReDim sResArr(1 To 1)
For Each sk In sDic.keys
Set sFld = sFso.GetFolder(sk)
Set sFiles = sFld.Files
For Each sf In sFiles
k = k + 1
If k > UBound(sResArr) Then ReDim Preserve sResArr(1 To k)
sResArr(k) = sf
Next
Next
GetAllFolderFiles = sResArr
Set sDic = Nothing
Set sFso = Nothing
End Function
【效果】