Vba excel создание папки: Создание папок с подпапками макросом VBA

Как получить список файлов в Excel с помощью VBA

Возможности Excel »


Макросы »
Список файлов в папке

Очень распространенная задача — получить список файлов из папок и подпапок на лист Excel. Кто-то делает каталог файлов для какого-нибудь отчета. Кто-то хочет обработать файлы в своей программе. В данной статье рассмотрим несколько вариантов реализации данной задачи от самого простого, до расширенного с поиском файлов по вложенным каталогам.

Скачать

Специально для примера я создал папку, в которой разместил несколько файлов различных типов и две подпапки. Вот так они выглядят:

Давайте рассмотрим несколько способов получения списка файлов.

Способ 1. Использование функции Dir

Этот способ хорош тем, что в данном случае мы не подключаем дополнительных библиотек, а пользуемся только предустановленным функционалом. Способ подойдет, если вам необходимо просто получить список файлов в папке и не нужно выводить их размер, определять тип файла, дату его создания/изменения и т. п. Тут мы получаем только наименования файлов и больше ничего.

Вот там код данной функции, который выводит на лист 1 перечень файлов.

'**************************************************************
' Sub            : ExampleOne
' Author         : Алексей Желтов
' Date           : 15.06.2020
' Purpose        : Вывод всех файлов в папке на лист
'**************************************************************
Sub ExampleOne()
    Dim Sh As Worksheet
    Dim Folder As String
    Dim FileName As String
    Dim i As Long
    Set Sh = ThisWorkbook.Sheets(1)
    Folder = Sh.Cells(3, 2)
    ' Проверка корректности введенных данных
    If PathExists(Folder) = False Then
        MsgBox "Указанной папки не существует", 16, "Ошибка исходных данных"
        Exit Sub
    End If
    ' Удаляем содержимое
    Sh.Rows("7:" & Sh.Range("A7").End(xlDown).Row).Delete Shift:=xlUp
    
    i = 7
    FileName = Dir(Folder & "/", vbNormal)
    Do While FileName <> ""
        Sh.Cells(i, 1) = i - 6
        Sh. Cells(i, 2) = FileName
        i = i + 1
        
        ' переход к следующему файлу
        FileName = Dir
    Loop
End Sub

Тут мы проверяем существование папки с помощью дополнительной функции. Опять таки не используем сторонних библиотек, а используем туже функцию Dir.

'**************************************************************
' Function       : PathExists
' Author         : Алексей Желтов
' Date           : 15.06.2020
' Purpose        : Возвращает ИСТИНА если путь pname существует
'**************************************************************
Private Function PathExists(pname As String) As Boolean
    On Error Resume Next
    If Dir(pname, vbDirectory) = "" Then
        PathExists = False
    Else
        PathExists = (GetAttr(pname) And vbDirectory) = vbDirectory
    End If
End Function

Вот так выглядит результат работы функции. Программа записала список файлов на текущий лист Excel.

Здесь мы не делали проверку на тип файла и вывели все файлы которые у нас были.  

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

    Do While FileName <> ""
    
        If LCase(FileName) Like "*xls*" Then
            Sh.Cells(i, 1) = i - 6
            Sh.Cells(i, 2) = FileName
            i = i + 1
        End If
        ' переход к следующему файлу
        FileName = Dir
    Loop

Знак «*» означает любой набор символов. Таким образом, мы учли различные версии файлов Excel (xls, xlsx, xlsm).

Способ 2. Используем объект FileSystemObject

В данном случае мы будем не просто получать названия файлов, но также определять тип файла, получать его размер и дату создания. Для этого нам потребуется использовать объект FileSystemObject. Он предоставляет нам сведения о файловой системе компьютера.

Однако, чтобы начать его использовать придется подключить одну библиотеку. Не пугайтесь, она есть на всех компьютерах с Windows, потому скачивать ничего не придется. Чтобы подключить ее необходимо:

1. Открыть пункт меню Tools и выбрать пункт References.
2. Выбрать ссылку на библиотеку Microsoft Scripting Runtime. 
3. Нажать Ок.

Теперь перейдем к коду. Он немного упростился:

'**************************************************************
' Sub            : ExampleTwo
' Author         : Алексей Желтов
' Date           : 15.06.2020
' Purpose        : Вывод всех файлов в папке на лист
'**************************************************************
Sub ExampleTwo()
    
    Dim Sh As Worksheet
    Dim FSO As New FileSystemObject
    Dim FolderPath As String
    Dim MyFolder As Folder
    Dim iFile As File
    Dim i As Long
    
    Set Sh = ThisWorkbook.Sheets(2)
    FolderPath = Sh.Cells(3, 2)
    
    ' Проверка корректности введенных данных
    If Not FSO.FolderExists(FolderPath) Then
        MsgBox "Указанной папки не существует", 16, "Ошибка исходных данных"
        Exit Sub
    End If
    
    ' Удаляем содержимое
    Sh. Rows("7:" & Sh.Range("A7").End(xlDown).Row).Delete Shift:=xlUp
    
    Set MyFolder = FSO.GetFolder(FolderPath)
     
    i = 7
    For Each iFile In MyFolder.Files
        Sh.Cells(i, 1) = i - 6
        Sh.Cells(i, 2) = iFile.Name
        Sh.Cells(i, 3) = iFile.Type
        Sh.Cells(i, 4) = iFile.DateCreated
        Sh.Cells(i, 5) = iFile.Size
        i = i + 1
    Next
     
End Sub

Обратите внимание на переменные. Переменная FSO — это новый экземпляр объекта FileSystemObject. Тут мы его объявляем и сразу создаем. Директива New очень важна, многие тут допускают ошибку. Также создаем объекты MyFolder и iFile — это тоже объекты FileSystemObject

    Dim Sh As Worksheet
    Dim FSO As New FileSystemObject ' объявляем и создаем новый экземпляр объекта 
    Dim FolderPath As String
    Dim MyFolder As Folder
    Dim iFile As File
    Dim i As Long

Далее делаем проверку на существование папки. В данном случае нам не нужна дополнительная функция , мы пользуемся методом FolderExists объекта (класса) FileSystemObject.

Ну и остается аналогично перебрать все файлы в директории. Тут удобно использовать цикл For Each — Next.

    For Each iFile In MyFolder.Files
        Sh.Cells(i, 1) = i - 6
        Sh.Cells(i, 2) = iFile.Name ' название файла
        Sh.Cells(i, 3) = iFile.Type ' тип файла
        Sh.Cells(i, 4) = iFile.DateCreated ' дата создания
        Sh.Cells(i, 5) = iFile.Size ' размер
        i = i + 1
    Next

Результат работы программы следующий:

Способ 3. Создаем функцию, которая возвращает файлы в папке и подпапках

Напоследок разберем функцию, которая будет возвращать нам все файлы в текущей папке и во вложенных папках. Вообще это универсальная функция, которая подойдет на все случаи жизни. Смело копируйте ее в свой проект! 

Итак перейдем к коду:

'**************************************************************
' Function       : GetFiles
' Author         : Алексей Желтов
' Date           : 15. 06.2020
' Purpose        : Получение файлов из папок и подпапок
'**************************************************************
Public Function GetFiles(ByVal Path As String, Optional ByVal Filter As String = "*", Optional ByVal Nesting As Long = 100) As Collection
    Dim MainFolder As Folder
    Dim iFolder As Folder
    Dim iFile As File
    Dim FSO As New FileSystemObject
    Dim MainColl As New Collection
    Dim iColl As Collection
    Dim spltFilter() As String
    Dim i As Long
    
    Set MainFolder = FSO.GetFolder(Path)
    If MainFolder Is Nothing Then Exit Function
    spltFilter = Split(Filter, ",")
    
    ' Перебираем файлы
    For Each iFile In MainFolder.Files
        ' Игнорируем временные файлы
        If InStr(1, iFile.Name, "~") = 0 Then
            ' Проверяем фильтры файлов
            For i = 0 To UBound(spltFilter)
                If LCase(iFile.Name) Like "*" & LCase(spltFilter(i)) Then
                    MainColl.Add iFile, iFile.Path
                End If
            Next
        End If
    Next
    
    ' Перебираем вложенные папки
    If Nesting > 0 Then
        For Each iFolder In MainFolder. SubFolders
            ' рекурсивный вызов функции
            Set iColl = GetFiles(iFolder.Path, Filter, Nesting - 1)
            
            'добавляем файлы из вложенных папок
            For i = 1 To iColl.Count
                MainColl.Add iColl(i), iColl(i).Path
            Next
        Next
    End If
    
    Set GetFiles = MainColl
End Function

Разберем основные моменты этой функции. На вход она принимает один обязательный аргумент — это путь к папке Path. Также может принимать два необязательных параметра:

• Filter — перечисление списка файлов, которые мы хотим получить. Перечислять необходимо через запятую, например «doc, xls*». Вы можете использовать символ «*» чтобы включить сравнение по шаблону. По умолчанию фильтр отсутствует и возвращаются все типы файлов.
• Nesting — вложенность. Это максимальное число вложенных папок в которые «проваливается» алгоритм. По умолчанию равно 100.

В целом по алгоритму комментарии лишние, все должно быть понятно. Основной момент хочу обратить на строку 38.

        For Each iFolder In MainFolder.SubFolders
            ' рекурсивный вызов функции
            Set iColl = GetFiles(iFolder.Path, Filter, Nesting - 1)
            
            'добавляем файлы из вложенных папок
            For i = 1 To iColl.Count
                MainColl.Add iColl(i), iColl(i).Path
            Next
        Next

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

Теперь когда наша функция готова, просто используем ее где нам требуется вот так:

'**************************************************************
' Sub            : ExampleThree
' Author         : Алексей Желтов
' Date           : 15.06.2020
' Purpose        : Вывод всех файлов в папке на лист
'**************************************************************
Sub ExampleThree()
    
    Dim Sh As Worksheet
    Dim FolderPath As String
    Dim iFile As File
    Dim i As Long
    Dim Coll As Collection
    Dim FSO As New FileSystemObject
    
    Set Sh = ThisWorkbook. Sheets(3)
    FolderPath = Sh.Cells(3, 2)
    
    Set Coll = GetFiles(FolderPath)
    
    For i = 1 To Coll.Count
        Set iFile = Coll(i)
        Sh.Cells(i + 6, 1) = i
        Sh.Cells(i + 6, 2) = iFile.Name
        Sh.Cells(i + 6, 3) = FSO.GetFolder(iFile.ParentFolder).Name
        Sh.Cells(i + 6, 4) = iFile.Type
        Sh.Cells(i + 6, 5) = iFile.DateCreated
        Sh.Cells(i + 6, 6) = iFile.Size
    Next
     
End Sub

Функция нам возвращает коллекцию файлов в папке и подпапках. Вот так:

Пример файла можете скачать по кнопке ниже и использовать в своей работе. Оставляйте комментарии, буду рад на них ответить.

Скачать

Рекомендуем к прочтению

Функции VBA и массивы значений

Аргументы функции на VBA

Комментарии:

Please enable JavaScript to view the comments powered by Disqus.comments powered by Disqus

VBA. Список файлов и папок в папке

Автор:
admin

|

06. 04.2022

Описание

Мы создаем макросы, которые отображают списки всех файлов в папке, папок и файлов в папках на листах Excel.

Решение

Список всех файлов внутри папки

‘Список файлов внутри подфайла get_file_names () Dim objFSO As Object’ Эта переменная будет содержать FileSystemObject Dim objFolder As Object ‘Эта переменная будет содержать объект Folder’ Доступ к файловой системе компьютера Set objFSO = CreateObject («Scripting.FileSystemObject») ‘Создать набор объектов папки objFolder = objFSO.GetFolder («c: \ Users \ timur.kryukov \ Downloads \ comrade.excel ideas \ VBA. Tutorial. Список всех файлов в \ Directory \»)’ Строка для вывода = 2 ‘Цикл для каждого файла в папке Для каждого файла в objFolder.Files’ Имя файла ячеек (строка, 1) = file.Name ‘Путь к папке ячеек (строка, 2) = objFolder’ Перейти к следующей строке строка = строка + 1 следующий файл Концевой переходник AutoFit

Список всех папок внутри папки

‘Список папок в подпапке get_subfolder_names () Dim objFSO As Object Dim objFolder As Object’ Доступ к файловой системе компьютера Set objFSO = CreateObject («Scripting. FileSystemObject») ‘Создание объекта папки Set objFolder = objFSO.GetFolder («Usersukov \ timur.kry \ Downloads \ comrade.excel ideas \ VBA. Tutorial. Перечислите все файлы в \ Directory \ «) ‘Построчно output = 2’ Пройдите по каждой папке в папке Для каждой папки В подпапках objFolder. ‘Выходной файл Имя ячеек (строка , 1) = folder.Name ‘Путь к папке Cells (row, 2) = folder.Path’ Перейти к следующей строке row = row + 1 Next folder ‘Автоматически подбирать столбцы («A»). Вся колонка. Концевой переводник AutoFit

Список всех файлов в папке, папок и файлов внутри папок

‘Список папок и файлов в них Sub get_subfolder_and_file_names () Dim objFSO As Object Dim objFolder As Object’ Доступ к файловой системе компьютера Установить objFSO = CreateObject («Scripting.FileSystemObject») ‘Создать объект папки Установить objFolder = objFSO. «: \ Users \ timur.kryukov \ Downloads \ comrade.excel ideas \ VBA. Tutorial. Перечислите все файлы в \ Directory \») ‘Строка к строке вывода = 2’ Прокрутите каждую папку Для каждой подпапки в objFolder . subfolders ‘ Цикл для каждого файла Для каждого файла в подпапке. Файлы ‘Имя папки ячеек (строка, 1) = подпапка. Имя’ Имя файла ячеек (строка, 2) = файл. Имя ‘Путь к файлу / папка ячейки (строка, 3) = файл .Path ‘Перейти к следующей строке line = line + 1 Next file Next subfolder Для каждого файла In objFolder.Files’ Имя папки ячеек (строка, 1) = objFolder.Name ‘Имя файла ячеек (строка, 2) = file .Name’ Путь к файлу ячеек (строка, 3) = file.Path ‘Перейти к следующей строке строка = строка + 1 Следующий файл End Sub

Примененные функции

• .GetFolder
• Клетки
• CreateObject
• Для каждого
• Scripting.FileSystemObject

excel — Создание каталога папки с использованием VBA в зависимости от значения ячейки

Задавать вопрос

спросил
3 года 9 месяцев назад

Изменено
6 месяцев назад

Просмотрено
2к раз

У меня есть электронная таблица Excel, которую я использую для отслеживания работы. Я хотел бы написать код в VBA, который создает каталог (с подпапками), зависящий от некоторых значений, которые были введены для каждой записи.

Столбец A: PIN-код
Б: Команда
C: Название

В уже установленном каталоге в Windows у меня есть папка, которая содержит папки всех команд, в которых мы работаем. По сути, я хочу, чтобы код просматривал значение команды в моем трекере и создавал новую папку (с подпапками) в этой области команды.

например: «C:\Teams\Team 1\новая папка идет сюда»

Я бы хотел, чтобы новая папка создавалась в формате PIN + Title из столбцов A и C. Кроме того, внутри каждой новой созданной папки Я бы хотел эти подпапки: «1_Comms», «2_Input», «3_Working», «4_Output».

например: «C:\Teams\Team 1\PIN value + Title» со всеми вышеупомянутыми подпапками, содержащимися в этом новом каталоге.

Буду очень признателен за любую помощь в этом, так как я полный ноль в VBA и все еще учусь.

Пока ничего не пробовал, кроме того, что поставил себя в неловкое положение.

• Excel
• ВБА

2

Для этого сначала создайте основную папку, как в вашем примере «C:\Teams\Team 1\PIN value + Title». Итак, после этого вы создаете подпапки.

 Sub CreateFolder (ByVal pin_value как строка, ByVal title как строка)
Dim wb_path как строка
Dim имя папки_1_путь, путь_к_папке_2, путь_к_папке_3, путь_к_папке_4 как строка
    wb_path = ЭтаРабочаякнига.Путь
    'создать основную папку
    wb_path = wb_path & "\" & pin_value & "_" & title
    MkDir (wb_path)
    'создать подпапку
    folder_1_path = wb_path & "\1_Comms"
    folder_2_path = wb_path & "\2_Input"
    folder_3_path = wb_path & "\3_Working"
    folder_4_path = wb_path & "\4_Output"
    MkDir (папка_1_путь)
    MkDir (папка_2_путь)
    MkDir (folder_3_path)
    MkDir (folder_4_path)
Конец сабвуфера
 

Если ваш PIN-код является целым числом, вам необходимо преобразовать его в строку. Как в этом тесте ниже:

 Sub test()
    pin_value = 777
    название = "моя папка"
    pin_value = CStr(pin_value)
    Вызов CreateFolder(pin_value, title)
Конец сабвуфера
 

2

Вы можете использовать эту рекурсивную функцию, которая позаботится об отсутствующих папках:

 Функция SmartCreateFolder(byVal sFolder as String) As Boolean
'вдохновлено: https://stackoverflow. com/a/54280512/78522
'Работает с буквами дисков, а также с путями UNC
    Статический oFSO как объект
    Если oFSO ничего не значит, установите oFSO = CreateObject("Scripting.FileSystemObject")
    On Error GoTo hell 'в основном для обработки запрещенных символов
    С ОФСО
        Если Не .FolderExists(sFolder) Тогда
            Если SmartCreateFolder(.GetParentFolderName(sFolder)) Тогда
                .CreateFolder sFolder
            Еще
                Иди к черту
            Конец, если
        Конец, если
    Конец с
    SmartCreateFolder = Истина
ад:
Конечная функция
 

Зарегистрируйтесь или войдите в систему

Зарегистрируйтесь с помощью Google

Зарегистрироваться через Facebook

Зарегистрируйтесь, используя электронную почту и пароль

Опубликовать как гость

Электронная почта

Требуется, но никогда не отображается

Опубликовать как гость

Электронная почта

Требуется, но не отображается

Нажимая «Опубликовать свой ответ», вы соглашаетесь с нашими условиями обслуживания и подтверждаете, что прочитали и поняли нашу политику конфиденциальности и кодекс поведения.

Создать несколько папок с макросами Excel с помощью VBA

спросил
2 года 10 месяцев назад

Изменено
2 года, 10 месяцев назад

Просмотрено
3к раз

Мне нужна помощь в создании макроса для создания нескольких папок в папке User Desktop MRO_FOLDERS .

У меня есть столбец Основная папка со списком основных папок. В каждой основной папке мне нужно создать все подпапки, указанные в столбце Подпапка уровня 1

Например: для Папка A Мне нужно создать

• рабочий стол\Папка A\SUB1
• Рабочий стол\Папка A\SUB2
• Рабочий стол\Папка A\SUB3

Мои познания в программировании плохие. Пожалуйста, смотрите мою текущую версию скрипта ниже

 Sub MakeDirs()
Dim Fldrpath как строка
    Fldrpath = Environ$("ПРОФИЛЬ ПОЛЬЗОВАТЕЛЯ") & "\Desktop\MRO_FOLDERS\"
Если Dir(Fldrpath, vbDirectory) = "" Тогда
MkDir Fldrpath
Конец, если
Для каждой ячейки в выборе
 MkDir Environ$("USERPROFILE") & "\Desktop\MRO_FOLDERS\" & cell.Value
 MkDir Environ$("USERPROFILE") & "\Desktop\MRO_FOLDERS\" & cell.Value & "\GANTT Charts"
 MkDir Environ$("USERPROFILE") & "\Desktop\MRO_FOLDERS\" & cell.Value & "\Induction"
 MkDir Environ$("ПРОФИЛЬ ПОЛЬЗОВАТЕЛЯ") & "\Desktop\MRO_FOLDERS\" & cell.Value & "\ Photos"
 MkDir Environ$("USERPROFILE") & "\Desktop\MRO_FOLDERS\" & cell.Value & "\Planning Meetings"
Следующая ячейка
 'Показать сообщение
    MsgBox "Новая папка >MRO_FOLDERS< успешно создана на рабочем столе!", vbInformation, "VBAF1"
Конец сабвуфера
 

Что делает работу, но мне нужно отредактировать макрос, если я хочу добавить или удалить подпапку уровня 1

• excel
• vba

1

Примерно так:

 Sub MakeDirs()
 Dim Fldrpath как строка, ws как рабочий лист, ячейка как диапазон, sf как диапазон
 Установите ws = ActiveSheet
 Fldrpath = Environ$("ПРОФИЛЬ ПОЛЬЗОВАТЕЛЯ") & "\Desktop\MRO_FOLDERS\"
 Если Dir(Fldrpath, vbDirectory) = "" Тогда
 MkDir Fldrpath
 Конец, если
 'при условии, что у вас нет второго списка в Col A
 Для каждой ячейки в ws.