mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Поиск самого нового файла в папке (с просмотром подпапок)

Функция 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

Комментарии

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
              ____    _____               __  __   ____  
_ __ ___ | ___| |___ / _ __ ___ | \/ | / ___|
| '_ ` _ \ |___ \ |_ \ | '_ ` _ \ | |\/| | \___ \
| | | | | | ___) | ___) | | | | | | | | | | | ___) |
|_| |_| |_| |____/ |____/ |_| |_| |_| |_| |_| |____/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.