Как сохранить все вложения из нескольких писем в одну папку в Outlook?

Сохранить все вложения из одного письма с помощью встроенной функции «Сохранить все вложения» в Outlook — легко. Однако если вам нужно сохранить вложения сразу из нескольких писем, прямого способа для этого не предусмотрено. Придётся поочерёдно применять функцию «Сохранить все вложения» к каждому сообщению, пока всё не окажется на месте — процесс долгий и утомительный. В этой статье мы предлагаем два эффективных метода для массового сохранения всех вложений из нескольких писем в указанную папку прямо в Outlook.

Сохранение всех вложений из нескольких писем в папку с помощью кода VBA
Несколько кликов для сохранения всех вложений из нескольких писем в папку с помощью замечательного инструмента

Сохранение всех вложений из нескольких писем в папку с помощью кода VBA

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

1. Сначала создайте на компьютере папку для сохранения вложений.

Перейдите в папку «Документы» и создайте там папку с названием «Attachments». См. снимок экрана:

2. Выберите письма, вложения из которых вы хотите сохранить, затем нажмите «Alt» + «F11», чтобы открыть окно Microsoft Visual Basic for Applications.

3. Выберите «Вставка» > «Модуль», чтобы открыть окно модуля, затем скопируйте в него один из приведённых ниже кодов VBA.

Код VBA 1: массовое сохранение вложений из нескольких писем (сохранение вложений с одинаковыми именами напрямую)

Совет: этот код сохранит вложения с одинаковыми именами, добавляя к имени файла цифры 1, 2, 3 и так далее.

Dim GCount As Integer
Dim GFilepath As String
Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
GFilepath = ""
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            GCount = 0
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            GFilepath = xFilePath
            xFilePath = FileRename(xFilePath)
            If IsEmbeddedAttachment(xAttachments.Item(i)) = False Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

Function FileRename(FilePath As String) As String
Dim xPath As String
Dim xFso As FileSystemObject
On Error Resume Next
Set xFso = CreateObject("Scripting.FileSystemObject")
xPath = FilePath
FileRename = xPath
If xFso.FileExists(xPath) Then
    GCount = GCount + 1
    xPath = xFso.GetParentFolderName(GFilepath) & "\" & xFso.GetBaseName(GFilepath) & " " & GCount & "." + xFso.GetExtensionName(GFilepath)
    FileRename = FileRename(xPath)
End If
xFso = Nothing
End Function

Function IsEmbeddedAttachment(Attach As Attachment)
Dim xItem As MailItem
Dim xCid As String
Dim xID As String
Dim xHtml As String
On Error Resume Next
IsEmbeddedAttachment = False
Set xItem = Attach.Parent
If xItem.BodyFormat <> olFormatHTML Then Exit Function
xCid = ""
xCid = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCid <> "" Then
    xHtml = xItem.HTMLBody
    xID = "cid:" & xCid
    If InStr(xHtml, xID) > 0 Then
        IsEmbeddedAttachment = True
    End If
End If
End Function

Код VBA 2: массовое сохранение вложений из нескольких писем (проверка на дубликаты)

Public Sub SaveAttachments()
'Update 20200821
Dim xMailItem As Outlook.MailItem
Dim xAttachments As Outlook.Attachments
Dim xSelection As Outlook.Selection
Dim i As Long
Dim xAttCount As Long
Dim xFilePath As String, xFolderPath As String, xSaveFiles As String
Dim xYesNo As Integer
Dim xFlag As Boolean
On Error Resume Next
xFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
Set xSelection = Outlook.Application.ActiveExplorer.Selection
xFolderPath = xFolderPath & "\Attachments\"
If VBA.Dir(xFolderPath, vbDirectory) = vbNullString Then
    VBA.MkDir xFolderPath
End If
For Each xMailItem In xSelection
    Set xAttachments = xMailItem.Attachments
    xAttCount = xAttachments.Count
    xSaveFiles = ""
    If xAttCount > 0 Then
        For i = xAttCount To 1 Step -1
            xFilePath = xFolderPath & xAttachments.Item(i).FileName
            xFlag = True
            If VBA.Dir(xFilePath, 16) <> Empty Then
                xYesNo = MsgBox("The file is exists, do you want to replace it", vbYesNo + vbInformation, "Kutools for Outlook")
                If xYesNo = vbNo Then xFlag = False
            End If
            If xFlag = True Then
                xAttachments.Item(i).SaveAsFile xFilePath
                If xMailItem.BodyFormat <> olFormatHTML Then
                    xSaveFiles = xSaveFiles & vbCrLf & "<Error! Hyperlink reference not valid.>"
                Else
                    xSaveFiles = xSaveFiles & "<br>" & "<a href='file://" & xFilePath & "'>" & xFilePath & "</a>"
                End If
            End If
        Next i
    End If
Next
Set xAttachments = Nothing
Set xMailItem = Nothing
Set xSelection = Nothing
End Sub

Примечания:

1) Если вы хотите сохранять все вложения с одинаковыми именами в одну папку, используйте приведённый выше «Код VBA 1». Перед запуском этого кода выберите «Сервис» > «Ссылки» и установите флажок «Microsoft Scripting Runtime» в диалоговом окне «Ссылки — Проект».

2) Если вы хотите проверять наличие дубликатов Имя вложения, используйте «Код VBA 2». После выполнения кода появится диалоговое окно с запросом о замене Дублировать вложения — выберите «Да» или «Нет» в зависимости от ваших потребностей.

5. Нажмите клавишу «F5», чтобы запустить код.

Теперь все вложения из выбранных писем сохранены в папку, созданную на шаге 1.

Примечание: может появиться диалоговое окно Microsoft Outlook — нажмите «Разрешить», чтобы продолжить.

Сохранение всех вложений из нескольких писем в папку с помощью замечательного инструмента

Если вы только начинаете работать с VBA, настоятельно рекомендуем воспользоваться утилитой «Save All Attachments» из надстройки «Kutools для Outlook» — с её помощью вы сможете за несколько кликов быстро сохранить все вложения сразу из нескольких писем прямо в Outlook.

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

Совет: вы можете выбрать несколько несмежных писем, удерживая клавишу «Ctrl» и выбирая их по одному;
или выделить несколько смежных писем, удерживая клавишу «Shift» и выбрав первое и последнее письмо.

2. Выберите «KUTOOLS PLUS» > «Инструменты вложений» > «Save All». См. снимок экрана:

3. В диалоговом окне «Настройки сохранения» нажмите кнопку , чтобы выбрать папку для сохранения вложений, затем нажмите кнопку «OK».

4. Нажмите «OK» дважды в появившихся диалоговых окнах — и все вложения из выбранных писем сразу сохранятся в указанную папку.

Примечания:

• 1. Чтобы сохранять вложения в разных папках в зависимости от писем, установите флажок «Создавать подпапки в следующем стиле» и выберите нужный стиль папки из раскрывающегося списка.
• 2. Помимо сохранения всех вложений, вы можете задать условия для выборочного сохранения. Например, чтобы сохранять только PDF-файлы, имена которых содержат слово «Invoice», нажмите кнопку «Дополнительные параметры», разверните раздел с условиями и настройте их, как показано ниже.
  
• 3. Если вы хотите автоматически сохранять вложения при получении писем, воспользуйтесь функцией Автосохранение вложений.
• 4. Чтобы сразу отсоединить вложения из выбранных писем, воспользуйтесь функцией Отсоединить все вложения из «Kutools для Outlook».

Связанные статьи

---

Лучшие инструменты для повышения продуктивности в Office

Оцените совершенно новый Kutools для Outlook с 100+ потрясающими функциями!Нажмите, чтобы скачать прямо сейчас!

🤖KUTOOLS AI:Использует передовые технологии ИИ для удобной работы с электронной почтой: ответы, составление резюме, оптимизация, расширение, перевод и создание писем.

📧Автоматизация работы с электронной почтой: Автоответ (доступен для POP и IMAP) / Планирование отправки писем / Авто Копия/Скрытая копия по правилам при отправке писем / Автоматическое перенаправление (расширенное правило) / Автоматическое добавление приветствия / Автоматическое разделение писем с несколькими получателями на отдельные сообщения…

📨Управление электронной почтой: Отозвать письмо / Блокировка спама по теме и другим признакам / Удаление дубликатов писем / Расширенный поиск / Организация папок…

📁Продвинутая работа с вложениями: Пакетное сохранение / Пакетное отсоединение / Пакетное сжатие / Автосохранение / Автоматическое отсоединение / Автоматическое сжатие…

🌟Волшебство интерфейса: 😊Еще больше красивых и стильных эмодзи / Напоминание о важных входящих письмах / Сворачивание Outlook вместо закрытия…

👍Чудеса одним щелчком: Ответить всем с вложениями / Защита от фишинговых писем / 🕘Отображение часового пояса: текущее время отправителя…

👩🏼‍🤝‍👩🏻Контакты и календарь: Пакетное добавление контактов из выбранных писем / Разделение группы контактов на отдельные группы / Удаление напоминания о дне рождения…

Используйте Kutools на вашем любимом языке — поддержка английского, испанского, немецкого, французского, китайского и более чем 40 других языков!

Мгновенно получите доступ к Kutools для Outlook одним щелчком! Не теряйте время — скачайте прямо сейчас и повысьте свою эффективность!

Список функций Kutools для Outlook      Скачать сейчас      Перейти к покупке

🚀 Скачать одним щелчком — Получите все надстройки для Office

Настоятельно рекомендуется: Kutools for Office (5 в 1)

Скачайте одним щелчком пять установщиковсразу —Kutools для Excel, Outlook, Word, PowerPointи Office Tab Pro.Нажмите, чтобы скачать прямо сейчас!

• ✅Удобство одним щелчком: Скачайте все пять установочных пакетов за одно действие.
• 🚀Готовы к любой задаче в Office: устанавливайте нужные надстройки именно тогда, когда они вам понадобятся.
• 🧰Входит в комплект: Kutools для Excel / Kutools для Outlook / Kutools для Word / Office Tab Pro / Kutools for PowerPoint

О пакете⬇ Скачать пакет💳 Приобрести пакет