Vba excel удалить папок

Хитрости »

28 Июль 2017              20503 просмотров

Предположим, что ежедневно во временную папку поступают файлы отчетов от филиалов. Они могут собираться из почты кодом вроде такого: Сохранить вложения из 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), а саму папку оставить, то строку 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
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика

Creating, deleting and renaming folders is a common requirement when automating processes with VBA.  The code snippets below should be sufficient to complete the most common folder tasks.

All the code examples below use the built-in Dir() function and its derivatives.  The File System Object methods are not covered in this post but will be covered at a future point.

Check if a folder exists

Referencing a folder which does not exist will result in an error, therefore it is often necessary to check if a folder exists before carrying out any other actions.

'Check if a folder exists
Dim folderPath As String
folderPath = "C:UsersmarksDocumentsFolder"

If Dir(folderPath, vbDirectory) <> "" Then

    'Insert action for if the folder exists
    'This example prints to the immediate window
    Debug.Print folderPath & " exists."

Else

    'Insert actions if the folder does not exist
    'This example prints to the immediate window
    Debug.Print folderPath & " does not exist."

End If

vbDirectory is the attribute of a folder.  The code above can be adapted to check for other types of files too.

For checking folder existence within another procedure, it is often easier to have a reusable function, which can be called upon when required.

'Reusable function to check if a folder exists
Function doesFolderExist(folderPath) As Boolean

DoesFolderExist = Dir(folderPath, vbDirectory) <> ""

End Function

The following VBA code calls the doesFolderExist function from above and prints True (the folder exists) or False (the folder does not exist) to the Immediate window.

'Call the reusable function to check for folder existence
Debug.Print doesFolderExist("C:UsersmarksDocumentsFolder")

The following VBA code calls the doesFolderExist function from above for use within an If statement.

'Check if a folder exists calling the doesFolderExist function
Dim folderPath As String
folderPath = "C:UsersmarksDocumentsFolder"

If doesFolderExist(folderPath) = True Then

    'Insert action for if the folder exists
    'This example prints to the immediate window
    Debug.Print folderPath & " exists."

Else

    'Insert actions if the folder does not exist
    'This example prints to the immediate window
    Debug.Print folderPath & " does not exist."

End If

Create a new folder

The VBA code below will create a new folder.  If the folder already exists, it will not overwrite it, but it will display an error.  The function will only create the last folder in the file path, all the parent folders must already exist.

'Create a new folder
MkDir "C:UsersmarksDocumentsNew folder"

The avoid an error, the code below will check if a folder exists before trying to create it.

'Create a folder if it does not already exist, if it does, do nothing 
Dim folderPath As String
folderPath = "C:UsersmarksDocumentsNew Folder"

'Check if the folder exists
If Dir(folderPath, vbDirectory) = "" Then

    'Folder does not exist, so create it
    MkDir folderPath

End If

As the Dir() function will only create a single folder, the code below loops through the individual folder names in the path and calls the Dir() function to create any missing folders and subfolders.

'Create all the folders in a folder path
Dim folderPath As String
Dim individualFolders() As String
Dim tempFolderPath As String
Dim arrayElement As Variant

'The desired folder path
folderPath = "C:UsersmarksDocumentsNew FolderNew FolderNew FolderNew Folder"

'Split the folder path into individual folder names
individualFolders = Split(folderPath, "")

'Loop though each individual folder name
For Each arrayElement In individualFolders

'Build string of folder path
    tempFolderPath = tempFolderPath & arrayElement & ""
 
    'If folder does not exist, then create it
    If Dir(tempFolderPath, vbDirectory) = "" Then
 
        MkDir tempFolderPath
 
     End If
 
Next arrayElement

Delete a folder

The RmDir function will delete a folder.  However, it is limited as it will only delete an empty folder.  All the files within the folder will need to be deleted first.  Using the File System Object method (which is not covered in this post) it is possible to delete folders and their contents.

'Delete a folder
Dim folderPath As String
folderPath = "C:UsersmarksDocumentsDelete Folder"

'Ensure the folder path as a "" at the end of the string
'Required for deleting the files using wildcards
If Right(folderPath, 1) <> "" Then folderPath = folderPath & ""

'Use wildcards to delete all the files in the folder
Kill folderPath & "*.*"

'Delete the now empty folder
RmDir folderPath

If the folder does not exist the RmDir function will display an error.  Refer to the first section of this post to check for existence

Rename a folder

The VBA code below will re-name a folder, and even move the contents of the entire folder to another location.

'Rename a folder
Name "C:UsersmarksDocumentsFolder" As "C:UsersmarksDocumentsRenamed Folder"

To use this example code, it may be necessary to check if the old folder name exists and the new folder name does not exist.