Sub ReadFiles()
    '浏览文件夹，读取所有文件
    '获取桌面路径
    Dim WshShell As Object
    Dim desktop  As String
    Set WshShell = CreateObject("WScript.Shell")
    desktop = WshShell.SpecialFolders("Desktop") & "\"
    
    Dim fd As FileDialog
    Dim reNamePath As String
    '显示文件夹选择对话框
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    fd.InitialFileName = desktop  '设置初始目录为c盘根目录
    fd.Title = "请选择一个文件夹" '设置对话框标题
    If fd.Show = -1 Then
        reNamePath = fd.SelectedItems(1) & "\"
    Else
        MsgBox "没有选择任何文件夹"
        Exit Sub
    End If

    rCount = ActiveCell.Row
    '表格清空
    For j = 1 To rCount
        Cells(j + 1, 1) = ""
        Cells(j + 1, 2) = ""
        Cells(j + 1, 3) = ""
        Cells(j + 1, 4) = ""
    Next

    '只读取文件名(不带路径)
    Dim a()
    MyName = Dir(reNamePath ,vbDirectory)
    Do While MyName <> ""
        If MyName <> "." And MyName <> ".." Then
            If (GetAttr(reNamePath & MyName) And vbDirectory) = vbDirectory Then
                i = i + 1
                ReDim Preserve a(i)
                a(i) = MyName & "\"
            Else
                i = i + 1
                ReDim Preserve a(i)
                'a(i) = Left(MyName, Len(MyName) - 4) '不显示文件扩展名
                a(i) = MyName
                
                'MsgBox Len(a(i))
                'If Len(a(i)) < 6 Then a(i) = "0" & a(i)
                
            End If
        End If
        MyName = Dir
    Loop
    
    '排序  xlDescending 对 Key1 按降序排序, xlAscending 对 Key1 按升序排序
    ' Range("A2:A800").Sort Key1:=Range("A1"), order1:=xlDescending, OrderCustom:=8
    For j = 1 To i
        Cells(j + 1, 1) = a(j)
    Next
End Sub