Блог

Главная - Вопросы по программированию - Удалите старые рабочие книги с текущей рабочей книгой на основе даты и количества

Удалите старые рабочие книги с текущей рабочей книгой на основе даты и количества

#excel #vba

Вопрос:

Привет,

Я создал инструмент для своей работы, который автоматически сохраняет файл резервной копии каждый раз, когда он закрывается. Теперь я хотел бы добавить код VBA, который удаляет эти файлы один раз:

А) В папке находится более 5 резервных файлов, ЕСЛИ

Б) Файлы старше 1 недели

Я примерно знаю, как перебирать вещи, но, поскольку это обусловлено, и книги, которые я пытаюсь сохранить, не являются активными книгами, я изо всех сил пытаюсь понять, как / если это возможно? Мне также нравится, чтобы все было просто, если это вообще возможно.

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

Если вам нужна какая-либо помощь, это код для автосохранения:

 If Weekday(Now(), vbSunday) = 3 Or Weekday(Now(), vbSunday) = 4 Or _
                                   Weekday(Now(), vbSunday) = 5 Then

    Application.DisplayAlerts = False
    Call ThisWorkbook.SaveAs("[source][file name]" amp; Format(Now(), "YYYYMMDD_hh.mmAM/PM") amp; ".xlsm")
    Application.DisplayAlerts = True

(извините, по корпоративным причинам я подвергла цензуре источник и имя файла)

Очень ценю вашу помощь!

Твое здоровье, дом

Ответ №1:

Во-первых, используйте FileSystemObject для сбора файлов из папки.

Затем, если количество файлов превышает пять, извлеките дату архива из каждого имени файла:

 Dim FileName    As String
Dim FileStamp   As String
Dim TextTime    As String
Dim FileTime    As Date

FileName = "YourFileNameYYYYMMDD_hh.mmAM/PM.xlsm"
FileStamp = Left(Right(FileName, 24), 19)
TextTime = Format(Replace(FileStamp, "_", ""), "@@@@ @@ @@ @@@@@ @@")
FileTime = CDate(TextTime)

Теперь выполните цикл сбора файлов и для каждого файла определите, является ли файл старше семи дней, и, если да, (все еще используется FileSystemObject ) удалите файл:

 If DateDiff("w", FileTime, Date) > 0 Then
    ' Delete the file.
    FileCount = FileCount - 1
End If

Когда FileCount достигнет пяти, выйдите (остановите) цикл.

Если вы не знакомы с FileSystemObject этим , сделайте это — для просмотра можно найти множество примеров и руководств.

Метки: