Создание папок по списку в excel макрос

 

Дро

Пользователь

Сообщений: 14
Регистрация: 10.10.2016

#1

10.10.2016 17:51:13

Здравствуйте.
Есть макрос создающий папки из заполненных ячеек одного столбца:

Код 
Sub MDir()
On Error Resume Next
For Each oCell In Range([A1], [A65536].End(xlUp))
    If Not IsEmpty(oCell) Then MkDir "C:" & oCell
Next
End Sub

Я добавляю к таблице новый список. Допустим первый столбец это страны (Россия, Казахстан). Второй города. И соответственно нужно создать на диске папку Россия, а в ней папки с названиями городов. И так для каждой страны. То есть одновременно сделать несколько папок стран и в каждой несколько папок городов.
 Можно ли это сделать усовершенствовав этот макрос или другим способом. В принципе не важно каким образом.
 

Sanja

Пользователь

Сообщений: 14838
Регистрация: 10.01.2013

#2

10.10.2016 18:08:46

Цитата
Дро написал:
первый столбец это страны (Россия, Казахстан). Второй города.

Покажите структуру этих столбцов

Согласие есть продукт при полном непротивлении сторон.

 

Дро

Пользователь

Сообщений: 14
Регистрация: 10.10.2016

Получается каждый столбец даёт один уровень папок. Первая папка страна, затем город, потом улица и в конце номер.

Изменено: Дро — 11.10.2016 22:08:58
 

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

Дро, код следует оформлять соответствующим тегом. Видели, как это выглядит у других?
Ищите такую кнопку и исправьте своё сообщение.
Спасибо!
 

Дро

Пользователь

Сообщений: 14
Регистрация: 10.10.2016

#5

11.10.2016 18:00:51

1
2
3
4
5
6
Код 
Sub MDir()
On Error Resume Next
For Each oCell In Range([A1], [A65536].End(xlUp))
    If Not IsEmpty(oCell) Then MkDir "C:" & oCell
Next
End Sub

Изменено: Дро — 11.10.2016 18:02:10
 

Дро

Пользователь

Сообщений: 14
Регистрация: 10.10.2016

#6

11.10.2016 18:05:06

у меня наверное не вышло с этими стрелками.

Ну я всё таки прошу помочь мне, а то у меня не выходит. Структура во вложении. Сначала идут папки b, в них c, в c находятся a.  
Нашёл ещё несколько кодов, но не получается в них разобраться.

Код 
Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" _
                                     (ByVal hwnd As Long, ByVal pszPath As String, _
                                      ByVal psa As Any) As Long
  
Sub CreateFolderWithSubfolders(ByVal ПутьСоздаваемойПапки$)
    ' функция получает в качестве параметра путь к папке
    ' если такой папки ещё нет - она создаётся
    ' может создаваться сразу несколько подпапок
    If Len(Dir(ПутьСоздаваемойПапки$, vbDirectory)) = 0 Then    ' если папка отсутствует
        SHCreateDirectoryEx Application.hwnd, ПутьСоздаваемойПапки$, ByVal 0&    ' создаём путь
    End If
Код 
Sub mkdir2(Путь$)
Set FSO = CreateObject("Scripting.FileSystemObject")
 a = Split(Путь, "")
For i = 0 To UBound(a)
 If a(i) <> "" Then
 aa = aa & a(i) & ""
 If FSO.FolderExists(aa) = False Then MkDir aa
 End If
 Next
 End Sub

Прикрепленные файлы

  • Книга1.xlsx (8.79 КБ)

Изменено: Дро — 11.10.2016 22:08:31
 

Дро

Пользователь

Сообщений: 14
Регистрация: 10.10.2016

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

Дро

Пользователь

Сообщений: 14
Регистрация: 10.10.2016

Я могу первым макросом в одной папке создать много папок за раз. Но в каждой из этих папок должно быть ещё по одной-две папки с номером. А первым коду это нереально. Это вручную менять в нём адрес каждый раз очень долго будет. Может можно сделать какие то ссылки на ячейки.

Изменено: Дро — 12.10.2016 12:38:30
 

VSerg

Пользователь

Сообщений: 370
Регистрация: 01.01.1970

#9

11.10.2016 20:31:37

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

Код 
Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" _
                                     (ByVal hwnd As Long, ByVal pszPath As String, _
                                      ByVal psa As Any) As Long

Sub Macro1()
Dim iLastRow As Long
Dim Path As String

iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To iLastRow
Path = "C:TEST111" & Cells(i, 1).Value & "" & Cells(i, 2).Value & "" & Cells(i, 3).Value & "" & Cells(i, 4).Value

    If Len(Dir(Path, vbDirectory)) = 0 Then
        SHCreateDirectoryEx Application.hwnd, Path, ByVal 0&
    End If

Next
End Sub
 

kuklp

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

#10

11.10.2016 21:08:56

Код 
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Sub www3()
    Dim i&
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        MakeSureDirectoryPathExists "C:TEST111" & Cells(i, 1).Value & "" & Cells(i, 2).Value & "" & Cells(i, 3).Value & "" & Cells(i, 4).Value
    Next
End Sub

Я сам — дурнее всякого примера! …

 

Дрозд

Пользователь

Сообщений: 3
Регистрация: 24.02.2016

Круто. Всё получилось. Спасибо! Код от

VSerg

использовал.

Изменено: Дрозд — 11.10.2016 22:14:05
 

Дро

Пользователь

Сообщений: 14
Регистрация: 10.10.2016

А можно исключить не только пустые ячейки, но и ячейки со значениями папки на которые создавать не надо? Папки из некоторых строчек создавать не надо.
 

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

Дро, Дрозд, снова Дро — с какой целью меняете?
 

JayBhagavan

Пользователь

Сообщений: 11833
Регистрация: 17.01.2014

ПОЛ: МУЖСКОЙ | Win10x64, MSO2019x64

Юрий М, это два разных пользователя (УИД разный), хотя физически м.б. один.

<#0>
Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori

 

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

Я вижу, но не исключено, что просто с разных машин. Подождём «ответчика» )
 

Дро

Пользователь

Сообщений: 14
Регистрация: 10.10.2016

Да это я с работы и из дома
 

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

Понятно. Две учётные записи?
 

Дро

Пользователь

Сообщений: 14
Регистрация: 10.10.2016
 

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

А теперь прочитайте Правила. Особое внимание на п. 3.3
 

Дро

Пользователь

Сообщений: 14
Регистрация: 10.10.2016

Мне надо было срочно на работе, а я не помнил пароль ни от сайта, ни от ящика через который зарегистрировался. Пришлось ещё раз зарегистрироваться.
 

Юрий М

Модератор

Сообщений: 60588
Регистрация: 14.09.2012

Контакты см. в профиле

#21

12.10.2016 12:39:45

Связывайтесь с администратором -владельцем сайта и объясняйте ситуацию.
Помощь Вам пока будет приостановлена.
Источник

Предположим, у вас есть список имен сотрудников в диапазоне рабочего листа, и теперь вы хотите создать несколько папок для каждого из них в ячейках для записи их информации. Если вы будете создавать папки одну за другой, это займет много времени. Но как быстро создать эти папки? Сегодня я расскажу вам несколько простых приемов:

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

Быстро создавайте папки на основе значений ячеек с Kutools for Excelхорошая идея3

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

Например, у меня есть диапазон имен на листе, я хочу создать папки для каждого из них и сохранить их по указанному пути, с кодом VBA я могу завершить эту задачу.

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

doc-create-папки1

2. Нажмите Застройщик > Визуальный Бейсик, Новый Microsoft Visual Basic для приложений появится окно, щелкните Вставить > Модули, и введите в модуль следующий код:

Код VBA: создание папок на основе значений ячеек

Sub MakeFolders()
Dim Rng As Range
Dim maxRows, maxCols, r, c As Integer
Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "" & Rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "" & Rng(r, c))
On Error Resume Next
End If
r = r + 1
Loop
Next c
End Sub

3. Нажмите док-умножить-расчет-3 кнопку для выполнения кода. Все выбранные ячейки были созданы в папки со своими значениями. И папки помещаются в путь так же, как активная книга. Смотрите скриншот:

doc-create-папки2

Быстро создавайте папки на основе значений ячеек с Kutools for Excel

Вам легко и удобно создавать папки на основе значений ячеек, если вы используете инструмент- Kutools for Excel.

После установки Kutools for Excel, пожалуйста, сделайте следующее:(Бесплатная загрузка Kutools for Excel Сейчас!)

1. Выберите диапазон, в котором вы хотите создать папки.

2. Нажмите Кутулс Плюс > Импорт / Экспорт > Создание папок из содержимого ячеек…, См. Снимок экрана:

doc создать папку 1

3. В Создание папок из содержимого ячеек диалоговое окно, нажмите doc-create-папки3кнопку, чтобы указать путь, по которому вы хотите сохранить папки. Видно скриншот:

doc создать папку 2

4. Нажмите OK. И окно подсказки напомнит вам, сколько папок было создано. Смотрите скриншот:

doc создать папку 3

5. Нажмите OK. И все значения в выбранном диапазоне были созданы папками в указанной папке.
doc создать папку 4

Перечислить все имена файлов из папки в лист

чтобы узнать больше об этой функции.

Вот утилита в Kutools for Excel – Список имен файлов может перечислить все имена файлов папки на листе, если он вам интересен, продолжайте читать.

После установки Kutools for Excel, пожалуйста, сделайте следующее:(Бесплатная загрузка Kutools for Excel Сейчас!)

1. Нажмите Кутулс Плюс > Импорт/Экспорт > Список имен файлов.
doc создать папку 5

2. в Список имен файлов диалоговом окне выберите папку, в которой вы хотите отобразить ее файлы, установите флажок Все файлы or Указывать вариант, как вам нужно в Тип файлов sдействие.
img src=»//cdn.extendoffice.com / images / stories / doc-excel / create-folder / doc-create-folder-6.png «alt =» doc create folder 6 «/>

3. Нажмите Okсоздается новый лист со всеми именами файлов и некоторой относительной информацией.
doc создать папку 7

Лучшие инструменты для работы в офисе

Kutools for Excel Решит большинство ваших проблем и повысит вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма …
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон…
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы… Предотвращение дублирования ячеек; Сравнить диапазоны…
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор …
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое …
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии…
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом …
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF…
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.

вкладка kte 201905

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!

офисный дно

Источник

Доброго времени суток, Уважаемые!
Столкнулся с задачей похожей на вышеизложенную, но с маленьким нюансом.
Суть такова:
Необходимо создать некое подобие базы данных. В идеале должно выглядеть как папка с названием, предположим «Объект», в котором будет Excelевский файл и папка «Фотографии».
В Excelевском файле будет некая информация и два столбца с данными (столбцы будут содержать данные типа 1,2,3..n и 1-2,2-3,3-4…m). А в папке «Фотографии» будут соответственно папки с названиями «1»,»2″,»3″…»n», «1-2″,»2-3″…»m». (как сделать такую вещь с помощью вышеизложенного варианта я понял) Идем дальше. Нужно сделать так, что бы при нажатии на ячейку с данными, например «1», открывалась папка «1»?
Вариант с гиперссылками пробовал. Вот в таком виде » =ГИПЕРССЫЛКА(«D:ОбъектФотографии»&A7&»») » в ячейке А7 стоит число 1. Потом протянув ячейку вниз получаем ссылки на А8,А9…и т.д. Способ хорош если эта база стационарна и находится в одном месте. При перемещении папки «Объект» в другую директорию, в первой ячейке где гиперссылка нужно вручную прописать новый путь, а потом протянуть по всему столбцу. Это очень неудобно, потому как планируется довольно частое копирование папки Объект другим пользователям. В каждом файле порядка 300 строк, а папок «Объект» будет в районе сотни…
И в итоге нужно что бы при перемещении папки «Объект» ссылки не сбивались и не нужно было вручную править пути.
Если у кого-то будут идеи и решения по этому поводу, буду премного благодарен!!!
Только если можно поподробнее…а то я в макросах…не очень…

Добавлено через 1 час 37 минут
Все-таки я допустил неточность…
Если сделать обычную гиперссылку на папку «1» из ячейки с данными 1, то при условии перемещения папки «Объект», содержащей Экселевский файл и папку «Фотографии», гиперссылки сохраняются. Проблема только в том, что бы автоматизировать присвоение гиперссылок ячейкам с другими данными (на подобии как » =ГИПЕРССЫЛКА(«D:ОбъектФотографии»&A7&»») » и протянуть вниз). Ибо при наличии порядка 300 ячеек с данными, присваивать каждой гиперссылку вручную… а папок «Объект» порядка сотни….

Добавлено через 22 минуты
И еще один вопрос, что нужно изменить в коде макроса по созданию папок, что бы, например папка Фотографии и вложенные в нее папки с именами из Экселевского файла, создавались при запуске макроса в той директории где в данный момент находится папка?

Источник

  • Функции WinAPI
  • Средства Windows
  • Работа с файлами

Как известно, VBA-функция MkDir может создать только папку в существующем каталоге (папке).

 
Например, код MkDir «C:Папка» отработает корректно в любом случае (создаст указанную папку),
а код MkDir «C:ПапкаПодпапкаКаталог» выдаст ошибку Run-time error ’76’: Path not found
(потому что невозможно создать каталог Подпапка в несуществующем ещё каталоге Папка)

 
Можно, конечно, использовать несколько функций MkDir подряд — но это усложняет код.

 
Самый простой способ решения проблемы — использование WinAPI-функции SHCreateDirectoryEx, которая может создать все нужные папки и подпапки за один запуск.

Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" _
                                     (ByVal hwnd As Long, ByVal pszPath As String, _
                                      ByVal psa As Any) As Long
 
 
Sub CreateFolderWithSubfolders(ByVal ПутьСоздаваемойПапки$)
    ' функция получает в качестве параметра путь к папке
    ' если такой папки ещё нет - она создаётся
    ' может создаваться сразу несколько подпапок
    If Len(Dir(ПутьСоздаваемойПапки$, vbDirectory)) = 0 Then    ' если папка отсутствует
        SHCreateDirectoryEx Application.hwnd, ПутьСоздаваемойПапки$, ByVal 0&    ' создаём путь
    End If
End Sub

Пример использования функции SHCreateDirectoryEx: 

Sub ПримерИспользованияCreateFolderWithSubfolders()
    ' этот макрос создаст на диске C папку "Создаваемая папка",
    ' в ней - подпапку "Подпапка", а в последней - подпапку 1234
    Путь = "C:Создаваемая папкаПодпапка1234"
 
    CreateFolderWithSubfolders Путь
End Sub
  • 69916 просмотров

Не получается применить макрос? Не удаётся изменить код под свои нужды?

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

Источник

Макрос создающий папки из списка.

Mark1976

 Дата: Суббота, 15.04.2023, 06:04 |
Сообщение № 1

Группа: Проверенные

Ранг: Ветеран

Сообщений: 685


Репутация:
3
±

Замечаний:
0% ±


Excel 2010, 2013

Здравствуйте знатоки экселя. На просторах интернета нашел макрос, который создает папки из списка. Папки создаются по пути, указанному в самом макросе. Можно сделать так, чтобы папки создавались автоматически там, где лежит сам макрос? Т.е. на выходе хочется увидеть: копирую макрос в нужную папку, запускаю его, получаю на выходе папки в том месте, где лежит сам макрос, а еще если можно сделать кнопку по запуску макроса?

К сообщению приложен файл:

9641299.xlsm
(15.4 Kb)
 

Ответить

Nic70y

 Дата: Суббота, 15.04.2023, 09:39 |
Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 8136


Репутация:
1999
±

Замечаний:
0% ±


Excel 2010

[vba]

Код

    If Not IsEmpty(oCell) Then MkDir ThisWorkbook.Path & oCell

[/vba]

ЮMoney 41001841029809

 

Ответить

Mark1976

 Дата: Суббота, 15.04.2023, 15:19 |
Сообщение № 3

Группа: Проверенные

Ранг: Ветеран

Сообщений: 685


Репутация:
3
±

Замечаний:
0% ±


Excel 2010, 2013

Nic70y, привет. Сделал все как сказали. Создал в папке «Для директора» папку «Тест». Положил в папку «Тест» макрос
[vba]

Код

Sub macros1()
On Error Resume Next
For Each oCell In Range([A1], [A9999].End(xlUp))
    If Not IsEmpty(oCell) Then MkDir ThisWorkbook.Path & oCell
Next
End Sub

[/vba]
В итоге. Файлы сохранились в папку «Для директора» и в начале файла стоит слово Тест. Спасибо конечно, но это не совсем то, что просил.
 

Ответить

i691198

 Дата: Суббота, 15.04.2023, 16:34 |
Сообщение № 4

Группа: Пользователи

Ранг: Участник

Сообщений: 60


Репутация:
21
±

Замечаний:
0% ±


но это не совсем то, что просил.

Все точно так как вы и хотели, а в чем проблема?
 

Ответить

Mark1976

 Дата: Суббота, 15.04.2023, 16:49 |
Сообщение № 5

Группа: Проверенные

Ранг: Ветеран

Сообщений: 685


Репутация:
3
±

Замечаний:
0% ±


Excel 2010, 2013

i691198, Файлы сохранились в папку «Для директора» и в начале файла стоит слово Тест
 

Ответить

i691198

 Дата: Воскресенье, 16.04.2023, 10:59 |
Сообщение № 6

Группа: Пользователи

Ранг: Участник

Сообщений: 60


Репутация:
21
±

Замечаний:
0% ±


Mark1976, А если записать так.
[vba]

Код

If Not IsEmpty(oCell) Then MkDir ThisWorkbook.Path & «» & oCell

[/vba]
 

Ответить

cmivadwot

 Дата: Воскресенье, 16.04.2023, 22:42 |
Сообщение № 7

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 146


Репутация:
45
±

Замечаний:
0% ±


Mark1976, гляньте…
 

Ответить
Источник

Понравилась статья? Поделить с друзьями:
  • Создание папки с ячейки excel
  • Создание панели кнопок для excel
  • Создание памятки в word
  • Создание официального документа в word
  • Создание отчетов в формате word