'如果我们要在Excel中获取某个文件夹中所有的文件列表，可以通过下面的VBA代码来进行。

'代码运行后，首先弹出一个浏览文件夹对话框，然后新建一个工作簿，

'并在工作表的A至F列分别列出选定文件夹中的所有文件的文件名、文件大小、创建时间、修改时间、访问时间及完整路径。方法如下：

'1.按Alt+F11，打开VBA编辑器，单击菜单“插入→模块”，将下面的代码粘贴到右侧的代码窗口中：

http://s10/mw690/001f8HsBgy6Jecusyo1d9&690

Sub GetFileList()

    Dim strFolder As String

    Dim varFileList As Variant

    Dim FSO As Object, myFile As Object

    Dim Arr As Variant

    Dim l As Long

    '显示打开文件夹对话框

    With Application.FileDialog(msoFileDialogFolderPicker)

        .Show

        If .SelectedItems.Count = 0 Then Exit Sub    '未选择文件夹

        strFolder = .SelectedItems(1)

    End With

    '获取文件夹中的所有文件列表

    varFileList = fcnGetFileList(strFolder)

    If Not IsArray(varFileList) Then

        MsgBox "未找到文件", vbInformation

        Exit Sub

    End If

    '获取文件的详细信息，并放到数组中

    ReDim Arr(0 To UBound(varFileList) + 1, 0 To 5)

    Arr(0, 0) = "文件名"

    Arr(0, 1) = "大小（字节）"

    Arr(0, 2) = "创建时间"

    Arr(0, 3) = "修改时间"

    Arr(0, 4) = "访问时间"

    Arr(0, 5) = "完整路径"

    Set FSO = CreateObject("Scripting.FileSystemObject")

    For l = 0 To UBound(varFileList)

        Set myFile = FSO.GetFile(strFolder & "" & CStr(varFileList(l)))

        Arr(l + 1, 0) = CStr(varFileList(l))

        Arr(l + 1, 1) = myFile.Size

        Arr(l + 1, 2) = myFile.DateCreated

        Arr(l + 1, 3) = myFile.DateLastModified

        Arr(l + 1, 4) = myFile.DateLastAccessed

        Arr(l + 1, 5) = myFile.Path

    Next l

    fcnDumpToWorksheet Arr

    Set myFile = Nothing

    Set FSO = Nothing

End Sub

Private Function fcnGetFileList(ByVal strPath As String, Optional strFilter As String) As Variant

' 将文件列表放到数组

    Dim f As String

    Dim i As Integer

    Dim FileList() As String

    If strFilter = "" Then strFilter = "*.*"

    Select Case Right(strPath, 1)

    Case "", "/"

        strPath = Left(strPath, Len(strPath) - 1)

    End Select

    ReDim Preserve FileList(0)

    f = Dir(strPath & "" & strFilter)

    Do While Len(f) > 0

        ReDim Preserve FileList(i) As String

        FileList(i) = f

        i = i + 1

        f = Dir()

    Loop

    If FileList(0) <> Empty Then

        fcnGetFileList = FileList

    Else

        fcnGetFileList = False

    End If

End Function

Private Sub fcnDumpToWorksheet(varData As Variant, Optional mySh As Worksheet)

    Dim iSheetsInNew As Integer

    Dim sh As Worksheet, wb As Workbook

    Dim myColumnHeaders() As String

    Dim l As Long, NoOfRows As Long

    If mySh Is Nothing Then

        '新建一个工作簿

        iSheetsInNew = Application.SheetsInNewWorkbook

        Application.SheetsInNewWorkbook = 1

        Set wb = Application.Workbooks.Add

        Application.SheetsInNewWorkbook = iSheetsInNew

        Set sh = wb.Sheets(1)

    Else

        Set mySh = sh

    End If

    With sh

        Range(.Cells(1, 1), .Cells(UBound(varData, 1) + 1, UBound(varData, 2) + 1)) = varData

        .UsedRange.Columns.AutoFit

    End With

    Set sh = Nothing

    Set wb = Nothing

End Sub

'2.关闭VBA编辑器，回到Excel工作表中，按Alt+F8，打开“宏”对话框，选择“GetFileList”，单击“运行”按钮。

新浪博客:http://weibo.com/u/1139851561

百度空间:http://hi.baidu.com/335081548

往期精彩在:

腾讯(QQ)微博:http://t.qq.com/huangshifang?preview

更多分享请关注微信号

微信号：Excel335081548 或:

雪山飞狐Excel

喜欢本文，请点击右上角，分享本文。