VBA создает последний измененный файл .XLS в папке

Question

Какой код 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

Answer 1

Я думаю, что вы ищете что-то вроде выбранного ответа для на этот вопрос .

Вы можете адаптировать код под свои конкретные требования, передавая аргумент в подобномфункция ниже.Обратите внимание, что аргумент 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 vs FileSystemObject

С точки зрения скорости, если папка, которую вы хотите просмотреть, содержит небольшое количество файлов, 2методы дадут вам одинаковые результаты примерно за одно и то же время.Однако, если в этой папке много файлов, использование подхода Dir Function вместо FileSystemObject должно значительно ускорить выполнение вашего макроса.Я не проверял это, но, похоже, это было сделано из ответов в на этот вопрос .

Answer 2

Вам просто нужно проверить DateLastModified отметку времени каждого файла в папке.Быстрая проверка, чтобы увидеть, является ли это самым последним, "сортирует" это к вершине.

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