VBA 在文件夹中生成最近修改的 .XLS 文件

VBA producing most recently modified .XLS file in a folder

我可以使用什么 VBA 代码来使用单元格中显示的文件夹路径来检索该文件夹中最近修改的 .xls 文件?到目前为止,我显示的是文件名,但不是正确的文件:

Function GetFileNames(ByVal FolderPath As String) As Variant
Dim Result As Variant
Dim i As Integer
Dim MyFile As Object
Dim MyFSO As Object
Dim MyFolder As Object
Dim MyFiles As Object
Set MyFSO = CreateObject("Scripting.FileSystemObject")
Set MyFolder = MyFSO.GetFolder(FolderPath)
Set MyFiles = MyFolder.Files
ReDim Result(1 To MyFiles.Count)
i = 1
For Each MyFile In MyFiles
Result(i) = MyFile.Name
i = i + 1
Next MyFile
GetFileNames = Result
End Function

您只需要检查文件夹中每个文件的 DateLastModified 时间戳。快速检查它是否是最新的 "sort" 它会排在最前面。

Option Explicit

Sub test()
    Debug.Print "most recently modified file is " & GetNewestModifiedFilename("C:\Temp")
End Sub

Function GetNewestModifiedFilename(ByVal folderPath As String, _
                                   Optional fileType As String = "xls*") As String
    Dim MyFSO As Object
    Dim MyFolder As Object
    Dim MyFiles As Object
    Set MyFSO = CreateObject("Scripting.FileSystemObject")
    Set MyFolder = MyFSO.GetFolder(folderPath)
    Set MyFiles = MyFolder.Files

    Dim mostRecentFilename As String
    Dim mostRecentTimestamp As Date
    Dim MyFile As Object
    For Each MyFile In MyFiles
        Debug.Print MyFile.Name & ", modified " & MyFile.DateLastModified
        If Mid(MyFile.Name, InStrRev(MyFile.Name, ".") + 1) Like fileType Then
            If MyFile.DateLastModified > mostRecentTimestamp Then
                mostRecentFilename = MyFile.Name
                mostRecentTimestamp = MyFile.DateLastModified
            End If
        End If
    Next MyFile
    GetNewestModifiedFilename = mostRecentFilename
End Function

我认为您要查找的内容类似于 this question 的选定答案。

您可以调整代码以满足您在内部传递参数的特定需求,例如下面的函数。请注意,参数 directory 必须在末尾包含反斜杠(例如 "C:\Users\")。

Function NewestFile(Directory As String) As String
'PURPOSE: Get the newest file name from specified directory
Dim FileName As String
Dim MostRecentFile As String
Dim MostRecentDate As Date
Dim FileSpec As String

'Specify the file type, if any
 FileSpec = "*.xls"
FileName = Dir(Directory & FileSpec)

If FileName <> "" Then
    MostRecentFile = FileName
    MostRecentDate = FileDateTime(Directory & FileName)
    Do While FileName <> ""
        If FileDateTime(Directory & FileName) > MostRecentDate Then
             MostRecentFile = FileName
             MostRecentDate = FileDateTime(Directory & FileName)
        End If
        FileName = Dir
    Loop
End If

NewestFile = MostRecentFile

End Function

编辑: 为了获得更大的灵活性,您还可以添加选项(如 PeterT 的修订答案)以使用可选的 FileSpec 搜索另一种类型的文件 参数类似于下面的替代函数。对于此函数,如果您不为 FileSpec 提供任何值,它将查看所​​有文件。

Function NewestFile(ByVal Directory As String, Optional ByVal FileSpec As String = "*.*") As String
'PURPOSE: Get the newest .xls file name from
Dim FileName As String
Dim MostRecentFile As String
Dim MostRecentDate As Date

'Specify the file type, if any
FileName = Dir(Directory & FileSpec)

If FileName <> "" Then
    MostRecentFile = FileName
    MostRecentDate = FileDateTime(Directory & FileName)
    Do While FileName <> ""
        If FileDateTime(Directory & FileName) > MostRecentDate Then
             MostRecentFile = FileName
             MostRecentDate = FileDateTime(Directory & FileName)
        End If
        FileName = Dir
    Loop
End If

NewestFile = MostRecentFile

End Function

速度问题:Dir 函数与 FileSystemObject

在速度方面,如果您要查看的文件夹中包含少量文件,这两种方法将在大致相同的时间内为您提供相同的结果。但是,如果该文件夹中有很多文件,使用 Dir Function 方法而不是 FileSystemObject 应该会大大加快您的执行速度宏。我还没有测试过,但这似乎是从 this question.

中的答案得出的结论