Хитрости »
Основные понятия (23)
Сводные таблицы и анализ данных (9)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (14)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (63)
Разное (38)
Баги и глюки Excel (2)

Как удалить папку или все файлы из папки через VBA

Предположим, что ежедневно во временную папку поступают файлы отчетов от филиалов. Они могут собираться из почты кодом вроде такого: Сохранить вложения из Outlook в указанную папку или добавляться в папку иными средствами. Далее Вы собираете данные из этих файлов неким кодом(вроде этого - Как собрать данные с нескольких листов или книг?). Но с каждым днем файлов все больше и больше и приходится заходить в папку и руками чистить её от лишних файлов, чтобы при сборе данных не приходилось каждый раз искать и отбирать только новые файлы.
Если надо удалять только конкретные файлы(например только файлы Excel, содержащие в имени слово "отчет"), то можно использовать такой код:

Sub Remove_AllFilesFromFolder()
    Dim sFolder As String, sFiles As String
    'диалог запроса выбора папки с файлами
    'подробнее про диалоги выбора папки или файла:
    '       http://www.excel-vba.ru/chto-umeet-excel/dialogovoe-okno-vybora-fajlovpapki/
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'отбирать только файлы Excel, содержащие в имени слово "отчет"
    sFiles = Dir(sFolder & "*отчет*.xls*")
    'цикл по всем файлам в папке
    On Error Resume Next
    Do While sFiles <> ""
        'удаляем файл
        Kill sFolder & sFiles
        If Err.Number = 70 Then
            MsgBox "Невозможно удалить файл '" & sFiles & "'. Возможно файл открыт в другой программе или нет прав на удаление", vbCritical, "www.excel-vba.ru"
            Err.Clear
        End If
        'на всякий случай передаем управление системе,
        'чтобы дождаться удаления
        DoEvents
        'получаем имя следующего файла в папке
        sFiles = Dir
    Loop
End Sub

Чтобы удалять полностью все файлы в папке, но папку оставить, то строку sFiles = Dir(sFolder & "*отчет*.xls*") надо записать так: sFiles = Dir(sFolder & "*")

Если необходимо удалять файлы по дате создания/изменения(например, только файлы, созданные раньше 01.03.2017), то можно использовать такой код:

Sub Remove_FilesFromFolder_AfterDate()
    Dim sFolder As String, sFiles As String
    Dim dd As Date, dKill As Date
 
    'задаем дату. Если файл был создан/изменен до этой даты - он будет удален
    dKill = CDate("01.03.2017") 'можно задать проще: dKill = #3/1/2017#
    'диалог запроса выбора папки с файлами
    'подробнее про диалоги выбора папки или файла:
    '       http://www.excel-vba.ru/chto-umeet-excel/dialogovoe-okno-vybora-fajlovpapki/
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    sFiles = Dir(sFolder & "*")
    'цикл по всем файлам в папке
    On Error Resume Next
    Do While sFiles <> ""
        'получаем дату создания или изменения файла
        dd = FileDateTime(sFolder & sFiles)
        'если дата файла меньше заданной для удаления(был создан раньше)
        If dd < dKill Then
            'удаляем файл
            Kill sFolder & sFiles
            If Err.Number = 70 Then
                MsgBox "Невозможно удалить файл '" & sFiles & "'. Возможно файл открыт в другой программе или нет прав на удаление", vbCritical, "www.excel-vba.ru"
                Err.Clear
            End If
            'на всякий случай передаем управление системе,
            'чтобы дождаться удаления
            DoEvents
        End If
        'получаем имя следующего файла в папке
        sFiles = Dir
    Loop
End Sub

Если необходимо всегда удалять файлы, дата создания которых раньше текущей, то строку dKill = CDate("01.03.2017") нужно заменить на такую: dKill = Date. Если удалить надо файлы недельной давности, то: dKill = Date-7


Если же необходимо удалить папку полностью, а не только файлы в ней, то лучше использовать такой код:

Sub RemoveFolderWithContent()
    Dim sFolder As String, sFiles As String
    'диалог запроса выбора папки на удаление
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'путь к папке можно задать статично, если он заранее известен и не изменяется
    '    sFolder = "C:\temp\Ежедневные отчеты\10072017" 'путь к папке, которую надо удалить
    Shell "cmd /c rd /S/Q """ & sFolder & """"
End Sub

Этот код удалить папку вместе со всеми файлами буквально за секунду.
Вообще в VBA есть специальная команда для удаления директорий(папок) RmDir. Но она способна удалить только пустую папку, поэтому редко когда можно найти её практическое применение. Если в файле есть хоть один файл то команда RmDir выдаст ошибку '75' - File/Path access error.

Так же см.:
Как средствами VBA переименовать/переместить/скопировать файл
Просмотреть все файлы в папке
Как собрать данные с нескольких листов или книг?
Как удалить книгу из самой себя


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Outlook Power Query и Power BI VBA работа в редакторе VBA управление кодами Бесплатные надстройки Дата и время Диаграммы и графики Записки Защита данных Интернет Картинки и объекты Листы и книги Макросы и VBA Надстройки Настройка Печать Поиск данных Политика Конфиденциальности Почта Программы Работа с приложениями Работа с файлами Разработка приложений Сводные таблицы Списки Тренинги и вебинары Финансовые Форматирование Формулы и функции Функции Excel Функции VBA Ячейки и диапазоны акции MulTEx анализ данных баги и глюки в Excel ссылки
Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти
Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2018 Excel для всех   Войти