提供了编程的基础技术教程

zl程序教程

您现在的位置是：首页 >  其他

当前栏目

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

文件 操作 所有 文件夹 获得 ExcelVBA
2023-06-13 09:15:37 时间

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 s End 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

【效果】

===今天学习到此===

更多的文章，请到我的公众号

相关文章