|
|||||||
Как удалить папку или все файлы из папки через VBA
Время создания: 16.03.2019 23:43
Текстовые метки: FileDialog, mso
Раздел: Разные закладки - VBA - GetOpen
Запись: xintrea/mytetra_db_adgaver_new/master/base/15149916377i4bonbr3q/text.html на raw.githubusercontent.com
|
|||||||
|
|||||||
Как удалить папку или все файлы из папки через VBA Предположим, что ежедневно во временную папку поступают файлы отчетов от филиалов. Они могут собираться из почты кодом вроде такого: Сохранить вложения из Outlook в указанную папку или добавляться в папку иными средствами. Далее Вы собираете данные из этих файлов неким кодом(вроде этого - Как собрать данные с нескольких листов или книг? ). Но с каждым днем файлов все больше и больше и приходится заходить в папку и руками чистить её от лишних файлов, чтобы при сборе данных не приходилось каждый раз искать и отбирать только новые файлы. 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 Этот код удалить папку вместе со всеми файлами буквально за секунду. |
|||||||
Так же в этом разделе:
|
|||||||
|
|||||||
|