vba - 使用 FileSystemObject 列出出现错误的文件

Question

我有 Excel-2007。我正在使用文件系统对象 VBA 代码列出目录中的文件。我还在 Excel 中设置了对 Microsoft Scriptlet 库的引用。我得到:

编译器错误:用户定义类型未定义

在第一个代码行

将 FSO 调暗为 Scripting.FileSystemObject

我使用的代码如下:

 Sub ListFilesinFolder()

    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim FileItem As Scripting.File

    SourceFolderName = "C:\mydir"

    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)

    Range("A1:C1") = Array("text file", "path", "Date Last Modified")

    i = 2
    For Each FileItem In SourceFolder.Files
        Cells(i, 1) = FileItem.Name
        Cells(i, 2) = FileItem
        Cells(i, 3) = FileItem.DateLastModified
        i = i + 1
    Next FileItem

    Set FSO = Nothing

End Sub

有人可以指出我错在哪里吗？

      **UPDATE -03-09-2015**   

我已经根据@brettdj 程序和一些研究更新了我的程序，以列出包括子文件夹文件在内的所有文件。这个对我有用。我期待进一步改进它的建议。

      Sub ListFilesinFolder()
           Dim objFSO As Object
           Dim ws As Worksheet
           Dim cl As Range
           Dim objFolderName As String

           objFolderName = "C:\FY_2015-2016\sunil"
           Set objFSO = New Scripting.FileSystemObject

           Set ws = ActiveSheet 
           With Range("A1:C1")
             .Value2 = Array("File", "path", "Date Last Modified")
             .Font.Bold = True
           End With

           Set cl = ws.Cells(2, 1)

           ListFolders cl, objFSO.GetFolder(objFolderName)
           Set objFSO = Nothing
    End Sub

    Sub ListFolders(rng As Range, Fol As Scripting.Folder)
          Dim SubFol As Scripting.Folder
          Dim FileItem As Scripting.File
          ' List Files
          For Each FileItem In Fol.Files
             rng.Cells(1, 1) = FileItem.Name
             rng.Cells(1, 2) = FileItem.ParentFolder.Path
             rng.Cells(1, 3) = FileItem.DateLastModified
             Set rng = rng.Offset(1, 0)
          Next
        ' Proces subfolders
         For Each SubFol In Fol.SubFolders
              ListFolders rng, SubFol
         Next
         With ActiveSheet
            .Columns.EntireColumn.AutoFit
         End With
    End Sub

我正在发布另一个更新，该更新不是逐个单元格填充的。 2015 年 9 月 3 日修订更新

  Sub GetFileList()

    Dim strFolder As String
    Dim objFSO As Object
    Dim objFolder As Object
    Dim myResults As Variant
    Dim lCount As Long

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    ' Get the directory from the user
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        'user cancelled
        strFolder = .SelectedItems(1)
    End With

    Set objFolder = objFSO.GetFolder(strFolder)

    'the variable dimension has to be the second one
    ReDim myResults(0 To 5, 0 To 0)

    ' place make some headers in the array
    myResults(0, 0) = "Filename"
    myResults(1, 0) = "Size"
    myResults(2, 0) = "Created"
    myResults(3, 0) = "Modified"
    myResults(4, 0) = "Accessed"
    myResults(5, 0) = "Full path"

    'Send the folder to the recursive function
    FillFileList objFolder, myResults, lCount

    ' Dump these to a worksheet
    fcnDumpToWorksheet myResults

    'tidy up
    Set objFSO = Nothing

    End Sub

Private Sub FillFileList(objFolder As Object, ByRef myResults As Variant, ByRef lCount As Long, Optional strFilter As String)

    Dim i As Integer
    Dim objFile As Object
    Dim fsoSubFolder As Object
    Dim fsoSubFolders As Object

    'load the array with all the files
    For Each objFile In objFolder.Files
        lCount = lCount + 1
        ReDim Preserve myResults(0 To 5, 0 To lCount)
        myResults(0, lCount) = objFile.Name
        myResults(1, lCount) = objFile.Size
        myResults(2, lCount) = objFile.DateCreated
        myResults(3, lCount) = objFile.DateLastModified
        myResults(4, lCount) = objFile.DateLastAccessed
        myResults(5, lCount) = objFile.Path
    Next objFile

    'recursively call this function with any subfolders
    Set fsoSubFolders = objFolder.SubFolders

    For Each fsoSubFolder In fsoSubFolders
        FillFileList fsoSubFolder, myResults, lCount
    Next fsoSubFolder

End Sub

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
        'make a workbook if we didn't get a worksheet
        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

    'since we switched the array dimensions, have to transpose
    With sh
        Range(.Cells(1, 1), .Cells(UBound(varData, 2) + 1, UBound(varData, 1) + 1)) = _
            Application.WorksheetFunction.Transpose(varData)

        .UsedRange.Columns.AutoFit
    End With

    Set sh = Nothing
    Set wb = Nothing

End Sub

Answer 1

建议使用数组方法来提高速度

Sub ListFilesinFolder()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim lngCnt As Long
    Dim X

    objFolderName = "C:\temp"

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(objFolderName)


    ReDim X(1 To objFolder.Files.Count, 1 To 3)

    For Each objFile In objFolder.Files
        lngCnt = lngCnt + 1
        X(lngCnt, 1) = objFile.Name
        X(lngCnt, 2) = objFile.Path
        X(lngCnt, 3) = Format(objFile.DateLastModified, "dd-mmm-yyyy")
    Next

    [a2].Resize(UBound(X, 1), 3).Value2 = X

    With Range("A1:C1")
        .Value2 = Array("text file", "path", "Date Last Modified")
        .Font.Bold = True
        .Columns.EntireColumn.AutoFit
    End With

End Sub