Хитрости »

28 Июль 2017 Дмитрий 22925 просмотров

Основные понятия (27)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (23)

Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (68)
Разное (43)
Баги и глюки Excel (5)

Как удалить папку или все файлы из папки через 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

Как использовать: Для начала надо убедиться, что разрешены макросы и при необходимости включить их: почему не работает макрос. Затем копируем код выше, из Excel переходим в редактор VBA(Alt+F11) -Insert -Module. Вставляем туда скопированный код. Теперь код можно вызывать нажатием клавиш Alt+F8 -выделяем Remove_AllFilesFromFolder -Выполнить(Run).
Чтобы удалять полностью все файлы в папке(а не только файлы Excel), а саму папку оставить, то строку 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 переименовать/переместить/скопировать файл
Просмотреть все файлы в папке
Как собрать данные с нескольких листов или книг?
Как удалить книгу из самой себя

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

Видеоуроки

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

Обсуждение: есть 1 комментарий

Максим:

18.06.2022 в 12:35

Спасибо, за макросы! Очень помогли.

С уважением,
Максим.

Ответить

Поделитесь своим мнением

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

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

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

Спасибо за сообщение