提取文件夹内的所有文件名

Sub 罗列所选择文件夹内的所有文件名()

    Dim FileToOpen, YN As Variant
    Dim 路径 As String, 文件对象 As String, 文件名称 As String, i As Long
    Dim Choose_rng As Range
    文件对象 = "所有文件 (*.*),*.*" '搜索所有文件

    '单选文件夹内的任意文件，目的是获取路径，如果没有选择任何文件则退出
    FileToOpen = Application.GetOpenFilename(FileFilter:=文件对象, Title:="请选择当前文件夹内的任意文件", MultiSelect:=False)
    If VBA.TypeName(FileToOpen) = "Boolean" Then
        MsgBox "没有选择文件": Exit Sub
    End If
    
    On Error Resume Next
A:
    Err.Clear
    Set Choose_rng = Application.InputBox(Prompt:="选择一个单元格", Type:=8)
    If Err.Number > 0 Then YN = MsgBox("1:选择“是”重新选择单元格" & Chr(10) & "2:选择否退出程序", vbYesNo, "未选择保存文件名的起始单元格") Else GoTo B
    If YN = vbYes Then GoTo A Else: Exit Sub
    On Error GoTo 0
B:
    路径 = StrReverse(Mid(StrReverse(FileToOpen), WorksheetFunction.Find("\", StrReverse(FileToOpen)), Len(FileToOpen)))
    文件名称 = Dir(路径 & "*.*")  '获取文件名

    Do '
        Choose_rng.Cells(1, 1).Offset(i + 1, 0) = 文件名称 '将找到的文件名写入选择的单元格
        文件名称 = Dir '查找其他文件
        i = i + 1
    Loop Until 文件名称 = ""
    Choose_rng.Cells(1, 1) = 路径 & "中包含的文件"
    MsgBox "写入文件名完成"
End Sub

1：对某个文件夹内的所有文件名称提取

2：自主修改部分代码做成小的应用

3：多适用于多表收集后的查漏补缺

源码视频演示

提取文件夹内的所有文件名

目录