时间戳

首页 > 解决方案 > 是否可以按修改日期的顺序读取文件？

excel - 是否可以按修改日期的顺序读取文件？

问题描述

我的宏需要读取一个非常大的文件目录并从中解析数据。该目录会定期更新，因此我正在尝试优化我的程序以仅读取自上次运行程序以来添加的文件。

到目前为止，使用 FileSystemObject 似乎我只能按字母顺序读取文件，如果我没记错的话。

到目前为止我最好的解决方案是每次读取所有文件，创建一个包含文件信息的数组，按 DateModified 排序，然后只打开我需要的文件。我很想知道是否可以通过按 DateModified 的顺序读取文件来跳过这一步。

提前致谢。

标签： excelvba

解决方案

Shell在这里似乎确实是一个不错的选择-尽管我没有将性能与FSO. 例如，您可以考虑forfiles允许您检索在指定日期之后修改的文件的命令？

一些示例代码如下：

Public Sub RunMe()
    Dim fileNames As Collection
    Dim path As String
    Dim dat As Date
    Dim file As Variant

    'Set the path and 'find after' date.
    path = "c:\user\documents"
    dat = #1/1/2018#

    'Fetch the files, setting mask as required.
    'This example is fetching all .txt files.
    Set fileNames = GetFilesModifiedAfter(path, dat, "*.txt")

    'Process the list of files.
    If Not fileNames Is Nothing Then
        For Each file In fileNames
            ' ... do stuff here.
            Debug.Print path & "\" & file
        Next
    End If

End Sub

Private Function GetFilesModifiedAfter( _
    path As String, _
    after As Date, _
    Optional mask As String) As Collection

    Dim cmd As String
    Dim piped() As String
    Dim result As Collection
    Dim i As Long

    'Build the command string.
    'Date must be formatted as MM/DD/YYYY.
    cmd = "cmd.exe /s /c forfiles /p " & _
        """" & path & """" & _
        " /d +" & Format(after, "mm/dd/yyyy")

    'Add the mask if passed-in.
    If mask <> vbNullString Then cmd = cmd & " /m " & mask

    'Execute the command and split by /r/n.
    piped = Split(CreateObject("WScript.Shell").Exec(cmd).StdOut.ReadAll, vbCrLf)

    'Leave if nothing is returned.
    If UBound(piped) = -1 Then Exit Function

    'Poplate the result collection,
    'and remove the leading and trailing inverted commas.
    Set result = New Collection
    For i = 0 To UBound(piped)
        If Len(piped(i)) > 2 Then
            result.Add Mid(piped(i), 2, Len(piped(i)) - 2)
        End If
    Next

    'Return the result collection.
    Set GetFilesModifiedAfter = result
End Function

更新

我刚刚做了一些测试，它似乎FSO更快，当然在包含少于 100 个文件的文件夹上。在非常大的文件夹（比如一千个文件）上运行它会很有趣，因为我本能地觉得Shell可能具有性能优势。但是，现在，这是FSO版本：

Private Function GetFilesModifiedAfter2( _
    path As String, _
    after As Date, _
    mask As String) As Collection

    Dim fso As Object, file As Object
    Dim result As Collection

    'Instance of objects.
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set result = New Collection

    'Iterate the files and test date last modified property.
    For Each file In fso.GetFolder(path & "\").Files
        If file.Name Like mask And file.DateLastModified > after Then
            result.Add file.Name
        End If
    Next

    'Return the result collection.
    Set GetFilesModifiedAfter2 = result
End Function

推荐阅读