Функция LastFile предназначена для поиска самого свежего файла в заданной папке

(производится поиск файлов по маске, и из найденных файлов выбирается тот, дата последнего изменения которого максимальна)

Пример использования функции:

Sub ПримерИспользованияФункции_LastFile()

    ' Ищем на рабочем столе все файлы TXT, и выводим имя самого нового файла.

    ' Просматриваются папки с глубиной вложения не более трёх.

    Dim ПутьКПапке$, СамыйПоследнийФайл$

    ' получаем путь к папке РАБОЧИЙ СТОЛ

    ПутьКПапке = CreateObject("WScript.Shell").SpecialFolders("Desktop")

    ' получаем путь к самому новому файлу (проверяется дата последнего сохранения)

    СамыйПоследнийФайл$ = LastFile$(ПутьКПапке, ".txt", 3)

    If СамыйПоследнийФайл$ = "" Then MsgBox "Не найдено ни одного файла", vbExclamation: Exit Sub

    MsgBox СамыйПоследнийФайл$, vbInformation, "Самый свежий файл"

End Sub

Код функции:

Function LastFile$(ByVal FolderPath As String, Optional ByVal Mask As String = "", _

                   Optional ByVal SearchDeep As Long = 999)

    ' Получает в качестве параметра путь к папке FolderPath,

    ' маску имени искомых файлов Mask (будут проверены только файлы с такой маской/расширением)

    ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).

    ' Возвращает полный путь к файлу, имеющему самую позднюю дату создания

    ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)

    Dim FilenamesCollection As New Collection    ' создаём пустую коллекцию

    Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject

    GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep    ' поиск

    Set FSO = Nothing: Application.StatusBar = False    ' очистка строки состояния Excel

    Dim maxFileDate As Double

    For Each file In FilenamesCollection ' перебираем все файлы среди найденных

        currFileDate = FileDateTime(file) ' считываем дату последнего сохранения

        ' проверяем очередной файл - не новее ли он предыдущих

        If currFileDate > maxFileDate Then LastFile$ = file: maxFileDate = currFileDate

    Next file

End Function

Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _

                                 ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)

    ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO

    ' перебор папок осуществляется в том случае, если SearchDeep > 1

    ' добавляет пути найденных файлов в коллекцию FileNamesColl

    On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)

    If Not curfold Is Nothing Then    ' если удалось получить доступ к папке

        Application.StatusBar = "Поиск в папке: " & FolderPath

        For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath

            If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path

        Next

        SearchDeep = SearchDeep - 1    ' уменьшаем глубину поиска в подпапках

        If SearchDeep Then    ' если надо искать глубже

            For Each sfol In curfold.SubFolders    ' ' перебираем все подпапки в папке FolderPath

                GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep

            Next

        End If

        Set fil = Nothing: Set curfold = Nothing    ' очищаем переменные

    End If

End Function

• 12621 просмотр