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

哆哆Excel

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

5300

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

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

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

近期学习了

=====start======

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

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

=====end======

今天要学习

注意标题，有顺序的哦：

1.先打开对话框==2.选择文件夹==3.获取文件列表

1-2两步可用我们的自定义函数

'打开对话框，选择，取得文件夹路径，返回stringFunction 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 WithEnd Function

进入文件夹后，接下来，要读取文件夹中的的文件列表（不包含子文件夹）

【知识点】

（1）Scripting.FileSystemObject得到一个FileSystemObject对象

（2）FileSystemObject对象取得它的子对象Folder

set f=fs. GetFolder进入文件夹

（3）取得子对象Folder中的Files集合

Set fc=f.Files

(4)再循环出文件列表

官方例子

Sub ShowFolderList(folderspec) Dim fs, f, f1, fc, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(folderspec) Set fc = f.Files For Each f1 in fc s = s & f1.name s = s & vbCrLf Next MsgBox sEnd Sub

可以由此把它写成一个函数

'输入文件夹，返回文件名列表（不包含子文件夹）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
    Dim arr()
     Range("A2").Resize(10000, 1) = ""
    FilePath = SelectGetFolder()
    If FilePath = "" Then MsgBox "没选择，退了": Exit Sub
    arr = GetFolderFiles(FilePath)
    t = UBound(arr)
    Range("A2").Resize(UBound(arr), 1) = Application.Transpose(arr)
    
End Sub
'输入文件夹，返回文件名列表（不包含子文件夹）
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 = temparr
End Function
'打开对话框，选择，取得文件夹路径，返回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

【效果】