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

哆哆Excel

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

2.2K00

代码可运行

文章被收录于专栏：哆哆Excel哆哆Excel

运行总次数：0

代码可运行

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

上一期，学习了

今天我们来学习如果取得文件夹中的子文件夹路径

如图

在我们可以先用上一节选择取得【test目录】

再读取【1目录、2目录、3目录】再读取……

上一期的程序

Sub FileDialog_sample1()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ThisWorkbook.Path
.Title = "选择文件夹"
If .Show = True Then
Range("B1") = .SelectedItems(1) & "\"
Else
MsgBox "你选择了“取消”"
End If
End With
End Sub

我们可以把它写成一个函数

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

用法是：Path= SelectGetFolder() 可以啦

【知识点】

FileSystemObject 对象是这样创建的Set fs = CreateObject("Scripting.FileSystemObject")返回一个对象对象中有一个方法：GetFolder方法可返回fs对象中的子对象：Folder 对象。 Folder对象中有一个属性是: SubFolders可返回文件夹中的子文件夹例如：Sub ShowFolderList(folderspec) Dim fs, f, f1, fc, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(folderspec) Set fc = f.SubFolders For Each f1 in fc s = s & f1.name s = s & vbCrLf Next MsgBox sEnd Sub
因此我们可以利用以上的知识点进行设计一个方法用于以上的要求的方法或者函数

FileSystemObject 对象是这样创建的Set fs = CreateObject("Scripting.FileSystemObject")返回一个对象对象中有一个方法：GetFolder方法可返回fs对象中的子对象：Folder 对象。 Folder对象中有一个属性是: SubFolders可返回文件夹中的子文件夹例如：Sub ShowFolderList(folderspec) Dim fs, f, f1, fc, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(folderspec) Set fc = f.SubFolders For Each f1 in fc s = s & f1.name s = s & vbCrLf Next MsgBox sEnd Sub

因此我们可以利用以上的知识点进行设计一个方法用于以上的要求的方法或者函数

函数如下

Function GetAllPath(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
    GetAllPath = sDic.keys
End Function

【主程序如下】

Sub yhd_ExcelVBA获得文件夹中的所有子文件夹()
    Dim myPath As String
    Dim arr
    myPath = SelectGetFolder()
    arr = GetAllPath(myPath)
    t = UBound(arr)
'    MsgBox t
    Range("a1").Resize(t, 1) = Application.Transpose(arr)
End Sub

【效果】