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

Как сохранить определенные вложения в папку в Экселе руководство для чайников

Главная » Макросы (VBA)

Автор Дмитрий Якушев На чтение 4 мин. Просмотров 2.4k.

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

Содержание

1. Как макрос работает
2. Код макроса
3. Как этот код работает
4. Как использовать

Как макрос работает

Поскольку этот код запускается из Excel, нам нужно установить ссылку на объект Microsoft Outlook Library. . Мы можем установить ссылку, открыв редактор Visual Basic в Excel и выбрав Tools➜References. Прокрутите вниз, пока мы не найдете запись Microsoft Outlook XX Object Library, где XX — это ваша версия Outlook. Поставьте флажок в поле рядом с записью.

Код макроса

Sub SohranitOpredelennieVlojeniya()
'Шаг 1: Объявляем переменные
Dim ns As Namespace
Dim MyInbox As MAPIFolder
Dim MItem As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
'Шаг 2: Установите ссылку на наш почтовый ящик
Set ns = GetNamespace("MAPI")
Set MyInbox = ns.GetDefaultFolder(olFolderInbox)
'Шаг 3: роверьте наличие сообщений в нашем почтовом ящике; выйти, если 'нет
If MyInbox.Items.Count = 0 Then
MsgBox "В папке нет сообщений."
Exit Sub
End If
'Шаг: оздать каталог для хранения вложений
On Error Resume Next
MkDir "C:\OffTheGrid\MyAttachments\"
'Шаг 5: Начните цикл по каждому элементу почты
For Each MItem In MyInbox.Items
'Шаг 6: Проверьте наличие слов в поле «Тема». 
If InStr(1, MItem.Subject, "Представление данных") < 1 Then
GoTo SkipIt
End If
'Шаг 7: Сохраните каждый с номером журнала; перейти к следующему 'вложению
i = 0
For Each Atmt In MItem.Attachments
FileName = _
"C:\Temp\MyAttachments\Attachment-" & i & "-" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
'Шаг 8: Перейти к следующему элементу почты
SkipIt:
Next MItem
'Шаг 9: Очистка памяти
Set ns = Nothing
Set MyInbox = Nothing
End Sub

Как этот код работает

1. Шаг 1 сначала объявляет шесть переменных. ns — это объект, используемый для предоставления пространства имен MAPI.
   MyInbox используется для предоставления целевой почтовой папки. MItem используется для раскрытия свойств почтовый элемент. Atmt — это переменная объекта, которая содержит объект Attachment. FileName является строковая переменная, которая содержит имя вложения. i является целочисленной переменной, используемой, чтобы убедиться, что каждое вложение сохранено как уникальное имя.
2. Шаг 2 устанавливает переменную MyInbox так, чтобы она указывала на папку «Входящие» для нашего почтового клиента по умолчанию.
3. Шаг 3 выполняет быструю проверку, чтобы убедиться, что в нашем почтовом ящике действительно есть сообщения. Если там нет сообщений, он выходит из процедуры с сообщением о том, что нет сообщений.
4. Шаг 4 создает каталог для хранения найденных вложений. Обратите внимание, что он использует On Error Resume Next. Это гарантирует, что код не выдаст ошибку, если каталог, который мы пытаемся создать уже существует.
5. Шаг 5 запускает цикл по каждому почтовому элементу в целевой почтовой папке.
6. На шаге 6 мы используем функцию Instr, чтобы проверить, находится ли строка Data Submission в Теме электронного письма. Если эта строка не существует, она нас не волнует. Поэтому мы заставляем код перейти на ссылку SkipIt (на шаге 8). Поскольку строка кода, следующая сразу за ссылкой SkipIt, является Команда «Переместить далее», в результате чего процедура переходит к следующему письму.
7. Шаг 7 перебирает и сохраняет каждое вложение в указанном нами каталоге. Обратите внимание, что мы добавляем целое число к имени каждого вложения. Это обеспечивает,что каждое вложение сохраняется как уникальное имя, что помогает нам избежать перезаписи.
8. Шаг 8 возвращается к шагу 5 до тех пор, пока не останется больше почтовых отправлений.
9. Как правило, рекомендуется освобождать объекты, назначенные нашим переменным. Это уменьшает вероятность любых проблем, вызванных объектами, которые могут оставаться открытыми в памяти. В коде мы просто устанавливаем переменную Nothing.

Как использовать

Для реализации этого макроса, вы можете скопировать и вставить его в стандартный модуль:

1. Активируйте редактор Visual Basic, нажав ALT + F11.
2. Щелкните правой кнопкой мыши имя проекта / рабочей книги в окне проекта.
3. Выберите Insert➜Module.
4. Введите или вставьте код.

Как сохранить все вложения в отдельной папке с помощью макроса в Эксель

Главная » Макросы (VBA)

Автор Дмитрий Якушев На чтение 3 мин. Просмотров 1.6k.

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

Содержание

1. Как макрос работает
2. Код макроса
3. Как этот код работает
4. Как использовать

Как макрос работает

Поскольку этот код запускается из Excel, нам нужно установить ссылку на объект Microsoft Outlook Library.. Мы можем установить ссылку, открыв редактор Visual Basic в Excel и выбрав Tools➜References. Прокрутите вниз, пока мы не найдете запись Microsoft Outlook XX Object Library, где XX — это ваша версия Outlook. Поставьте флажок в поле рядом с записью.

Код макроса

Sub SohranitVseVlojeniya()
'Шаг 1: Объявляем переменные
Dim ns As Namespace
Dim MyInbox As MAPIFolder
Dim MItem As MailItem
Dim Atmt As Attachment
Dim FileName As String
'Шаг 2: Установите ссылку на наш почтовый ящик
Set ns = GetNamespace("MAPI")
Set MyInbox = ns.GetDefaultFolder(olFolderInbox)
'Шаг 3: Проверьте наличие сообщений в нашем почтовом ящике; выйти, если 'нет
If MyInbox.Items.Count = 0 Then
MsgBox "В папке нет сообщений."
Exit Sub
End If
'Шаг 4: Создать каталог для хранения вложений
On Error Resume Next
MkDir "C:\Temp\MyAttachments\"
'Шаг 5: Начните цикл по каждому элементу почты
For Each MItem In MyInbox.Items
'Шаг 6: Сохраните каждое вложение и перейдите к следующему
For Each Atmt In MItem.Attachments
FileName = "C:\Temp\MyAttachments\" & Atmt.FileName
Atmt.SaveAsFile FileName
Next Atmt
'Шаг 7: Перейти к следующему элементу почты
Next MItem
'Шаг 8: Очистка памяти
Set ns = Nothing
Set MyInbox = Nothing
End Sub

Как этот код работает

1. Шаг 1 объявляет пять переменных. ns — это объект, используемый для предоставления пространства имен MAPI. MyInbox используется для показа целевой почтовой папки. MItem используется для выставления свойств почты. Atmt — это переменная объекта, которая содержит объект Attachment. FileName — это строковая переменная, которое содержит имя вложения.
2. Шаг 2 устанавливает переменную MyInbox так, чтобы она указывала на папку «Входящие» для почтового клиента по умолчанию.
3. Шаг 3 выполняет быструю проверку, чтобы убедиться, что в папке «Входящие» действительно есть сообщения. Если там нет сообщений, макрос завершает процедуру с окном сообщения о том, что Сообщений нет.
4. Шаг 4 создает каталог для хранения найденных вложений. Хотя вы могли бы использовать существующий, лучше создать новый каталог. Обратите внимание, что мы используем On Error Resume Next. Это гарантирует, что код не выдаст ошибку, если каталог, который мы пытаемся создать уже существует.
5. Шаг 5 запускает цикл по каждому почтовому элементу в целевой почтовой папке.
6. Шаг 6 гарантирует, что каждый почтовый элемент, который мы перебираем, проверяется на вложения. Цикл сохраняет каждое вложение, которое мы находим в указанном каталоге, который создали.
7. Шаг 7 возвращается к шагу 5 до тех пор, пока не останется больше почтовых отправлений.
8. Как правило, рекомендуется освобождать объекты, назначенные нашим переменным. Это уменьшает вероятность любых проблем, вызванных объектами, которые могут оставаться открытыми в памяти. В коде мы просто устанавливаем переменную Nothing.

Как использовать

Для реализации этого макроса, вы можете скопировать и вставить его в стандартный модуль:

1. Активируйте редактор Visual Basic, нажав ALT + F11.
2. Щелкните правой кнопкой мыши имя проекта / рабочей книги в окне проекта.
3. Выберите Insert➜Module.
4. Введите или вставьте код.

excel — VBA Create Subfolder In Today’s Folder

У меня есть оператор, который создает новую папку с сегодняшней датой, и это работает без сбоев.

Теперь я хочу создать в этой папке подпапку под названием «Проверка». Моя проблема в том, что я не могу понять, как определить путь, если основная папка никогда не будет иметь такое же имя (формат = ггггммдд). Есть совет, как это написать?

Вот что у меня сейчас есть:

 Dim Path As String
Dim d как строка
Путь = "C:\Maintenance\Validation\"
    Если Len(Dir(Путь, vbDirectory)) = 0 Тогда
        MsgBox «Путь не существует.», vbCritical
        Выйти из подпрограммы
    Конец, если
d = Формат(Дата, "ггггммдд")
    Если Len(Dir(Путь и d, vbDirectory)) = 0 Тогда MkDir (Путь и d)
ActiveWorkbook.SaveAs Имя файла: = Путь & d & "\" & d & ".xlsm", FileFormat: = xlOpenXMLWorkbookMacroEnabled
 

• excel
• vba

Добавьте еще одну проверку и создайте подпапку, если она отсутствует:

 Путь = "C:\Maintenance\Validation\"
d = Формат(Дата, "ггггммдд")
Если Len(Dir(Path & d, vbDirectory)) = 0 Then MkDir Path & d
Если Len(Dir(Path & d & "\Validation", vbDirectory)) = 0 Then MkDir Path & d & "\ Validation"
 

Вы можете немного почистить его, выдвинув «проверить/создать» в отдельный суб:

 Sub tester()
    Dim path как строка, d как строка
    путь = "C:\Maintenance\Validation\"
    d = Формат(Дата, "ггггммдд")
    Убедитесь, что путь к папке и d
    Путь к папке SureFolder & d & "\ Validation"
Конец сабвуфера
'создать папку, если она еще не существует
Подпрограмма SureFolder (p как строка)
    Если Len(Dir(p, vbDirectory)) = 0 Тогда MkDir p
Конец сабвуфера
 

Вы можете сделать это, добавив еще один оператор If .

 Sub CreateDir()
Тусклый путь как строка
Dim d как строка
Путь = "C:\Users\hamza\Desktop\RT\DATABASE\ipynb\"
    Если Len(Dir(Путь, vbDirectory)) = 0 Тогда
        MsgBox «Путь не существует.», vbCritical
        Выйти из подпрограммы
    Конец, если
d = Формат(Дата, "ггггммдд")
папка = Путь & d
    Если Len(Dir(Путь и d, vbDirectory)) = 0 Тогда MkDir (Путь и d)
    подпапка = папка & "\ Validation"
    Если Len(Dir(подпапка, vbDirectory)) = 0 Тогда MkDir (подпапка)
    
ActiveWorkbook.SaveAs Имя файла: = папка & "\" & d & ".xlsm", FileFormat: = xlOpenXMLWorkbookMacroEnabled
Конец сабвуфера
 

Это создаст следующее дерево:

 Путь
---------20220818
-----------------------20220818.xlsm
-----------------------Проверка
 

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

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

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

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

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

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

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

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

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

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

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

Код VBA для создания, удаления и управления папками

Создание, удаление и переименование папок — обычное требование при автоматизации процессов с помощью VBA. Приведенных ниже фрагментов кода должно быть достаточно для выполнения наиболее распространенных задач с папками.

Во всех приведенных ниже примерах кода используется встроенная функция Dir() и ее производные. Методы объекта файловой системы не рассматриваются в этом посте, но будут рассмотрены в будущем.

Проверить, существует ли папка

Ссылка на несуществующую папку приведет к ошибке, поэтому перед выполнением любых других действий часто необходимо проверить, существует ли папка.

 'Проверить, существует ли папка
Путь к папке Dim As String
путь к папке = "C:\Users\marks\Documents\Folder"
Если Dir(folderPath, vbDirectory) <> "" Тогда
    'Вставить действие, если папка существует
    'Этот пример печатает в ближайшее окно
    Путь к папке Debug. Print и «существует».
Еще
    'Вставить действия, если папка не существует
    'Этот пример печатает в ближайшее окно
    Путь к папке Debug.Print и «не существует».
Конец, если 

vbDirectory — атрибут папки. Приведенный выше код можно адаптировать для проверки файлов других типов.

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

 'Многократно используемая функция для проверки существования папки
Функция doFolderExist (folderPath) как логическое значение
DoesFolderExist = Dir(folderPath, vbDirectory) <> ""
Завершить функцию 

Следующий код VBA вызывает функцию doFolderExist сверху и печатает True (папка существует) или False (папка не существует) в окне Immediate.

 'Вызов многоразовой функции для проверки существования папки
Debug.Print DoesFolderExist("C:\Users\marks\Documents\Folder") 

Следующий код VBA вызывает функцию doFolderExist для использования в операторе If.

 'Проверить, существует ли папка, вызывая функцию doFolderExist
Путь к папке Dim As String
путь к папке = "C:\Users\marks\Documents\Folder"
Если действительноFolderExist(folderPath) = True Тогда
    'Вставить действие, если папка существует
    'Этот пример печатает в ближайшее окно
    Путь к папке Debug.Print и «существует».
Еще
    'Вставить действия, если папка не существует
    'Этот пример печатает в ближайшее окно
    Путь к папке Debug. Print и «не существует».
Конец, если 

Создать новую папку

Приведенный ниже код VBA создаст новую папку. Если папка уже существует, она не перезапишет ее, но отобразит ошибку. Функция создаст только последнюю папку в пути к файлу, все родительские папки уже должны существовать.

 'Создать новую папку
MkDir "C:\Users\marks\Documents\New folder" 

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

 'Создать папку, если она еще не существует, если она существует, ничего не делать
Путь к папке Dim As String
folderPath = "C:\Users\marks\Documents\Новая папка"
'Проверить, существует ли папка
Если Dir(folderPath, vbDirectory) = "" Тогда
    'Папка не существует, поэтому создайте ее
    Папка MkDirПуть
Конец, если 

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

 'Создать все папки по пути к папке
Путь к папке Dim As String
Dim IndividualFolders() как строка
Dim tempFolderPath как строка
Dim arrayElement как вариант
'Путь к нужной папке
folderPath = "C:\Users\marks\Documents\Новая папка\Новая папка\Новая папка\Новая папка"
'Разбить путь к папке на отдельные имена папок
отдельные папки = разделить (путь к папке, "\")
'Пройтись по каждому отдельному имени папки
Для каждого элемента массива в отдельных папках
'Построить строку пути к папке
    tempFolderPath = tempFolderPath & arrayElement & "\"
 
    'Если папки нет, то создайте ее
    Если Dir(tempFolderPath, vbDirectory) = "" Тогда
 
        MkDir tempFolderPath
 
     Конец, если
 
Следующий элемент массива 

Удалить папку

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

 'Удалить папку
Путь к папке Dim As String
folderPath = "C:\Users\marks\Documents\Удалить папку"
'Убедитесь, что путь к папке указан как "\" в конце строки
'Требуется для удаления файлов с использованием подстановочных знаков
Если Правильно (путь к папке, 1) <> "\" Тогда путь к папке = путь к папке & "\"
'Используйте подстановочные знаки, чтобы удалить все файлы в папке
Убить путь к папке и "*.*"
'Удалить теперь пустую папку
Папка RmDirПуть 

Если папка не существует, функция RmDir отобразит ошибку. Обратитесь к первому разделу этого сообщения, чтобы проверить наличие

Переименовать папку

Приведенный ниже код VBA переименует папку и даже переместит содержимое всей папки в другое место.

 'Переименовать папку
Имя "C:\Users\marks\Documents\Folder" Как "C:\Users\marks\Documents\Renamed Folder" 

Чтобы использовать этот пример кода, может потребоваться проверить, существует ли старое имя папки и новое имя. имя папки не существует.

Об авторе

Привет, меня зовут Марк, и я запускаю Excel Off The Grid.

Мои родители рассказали мне, что в возрасте 7 лет я объявил, что стану квалифицированным бухгалтером. Либо я был экстрасенсом, либо у меня не было воображения, как это и произошло. Однако мое путешествие по-настоящему началось только в 35 лет.

В 2015 году я устроился на новую работу, на которой регулярно работал после 22:00. В результате я редко видел своих детей в течение недели. Итак, я начал искать секреты автоматизации Excel. Я обнаружил, что, создав небольшое количество простых инструментов, я могу комбинировать их по-разному, чтобы автоматизировать почти все свои обычные задачи. Это означало, что я мог работать меньше часов (и мне повысили зарплату!). Сегодня я обучаю этим техникам других специалистов в рамках нашей программы обучения, чтобы они тоже могли проводить меньше времени на работе (и больше времени со своими детьми и любимыми делами).

Вам нужна помощь в адаптации этого поста к вашим потребностям?

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

Но если вы все еще испытываете трудности, вам следует:

1. Почитайте другие блоги или посмотрите видео на YouTube по той же теме. Вы получите гораздо больше пользы, открыв для себя собственные решения.
2. Спросите «Excel Ninja» в вашем офисе. Удивительно, какие вещи знают другие люди.
3. Задайте вопрос на форуме, таком как Mr Excel, или в сообществе Microsoft Answers. Помните, что люди на этих форумах обычно отдают свое время бесплатно. Поэтому постарайтесь сформулировать свой вопрос, убедитесь, что он четкий и лаконичный. Перечислите все, что вы пробовали, и предоставьте скриншоты, сегменты кода и примеры книг.
4. Используйте Excel Rescue, моего партнера-консультанта. Они помогают, предоставляя решения небольших проблем Excel.