Перейти к основному содержанию

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

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

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


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

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

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

Попасть в Документы папку и создайте папку с именем «Вложения». Смотрите скриншот:

2. Выберите электронные письма, вложения которых вы сохраните, а затем нажмите другой + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

3. Нажмите Вставить > Модули для открытия Модули window, а затем скопируйте в окно один из следующих кодов 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 коробка в Ссылки - Проект диалоговое окно;

doc сохранить вложения07

2) Если вы хотите проверить повторяющиеся имена вложений, примените код VBA 2. После запуска кода появится диалоговое окно с напоминанием о замене повторяющихся вложений, выберите Да or Нет в зависимости от потребностей.

5. нажмите F5 ключ для запуска кода.

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

Ноты: Там может быть Microsoft Перспективы всплывающее окно подсказки, пожалуйста, нажмите Разрешить кнопку, чтобы продолжить.


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

Если вы новичок в VBA, здесь настоятельно рекомендуется Сохранить все вложения полезности Kutools для Outook для вас. С помощью этой утилиты вы можете быстро сохранить все вложения из нескольких писем сразу несколькими щелчками мыши только в Outlook.
Перед применением функции, пожалуйста, сначала загрузите и установите Kutools for Outlook.

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

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

2. Нажмите Кутулс >Инструменты для вложенияСохраните все. Смотрите скриншот:

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

3. Нажмите OK дважды в следующем всплывающем диалоговом окне. Затем все вложения в выбранных электронных письмах сразу сохраняются в указанной папке.

Ноты:

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

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


Статьи по теме

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

Автоматически загружать / сохранять вложения из Outlook в определенную папку
Вообще говоря, вы можете сохранить все вложения одного электронного письма, щелкнув «Вложения»> «Сохранить все вложения в Outlook». Но если вам нужно сохранить все вложения из всех полученных писем и получающих писем, какой идеал? В этой статье будут представлены два решения для автоматической загрузки вложений из Outlook в определенную папку.

Распечатать все вложения в одном / нескольких письмах в Outlook
Как вы знаете, он будет печатать только содержимое электронной почты, такое как заголовок, тело, когда вы нажимаете Файл> Печать в Microsoft Outlook, но не печатает вложения. Здесь мы покажем вам, как легко распечатать все вложения в выбранном электронном письме в Microsoft Outlook.

Искать слова во вложении (содержимом) в Outlook
Когда мы вводим ключевое слово в поле мгновенного поиска в Outlook, оно будет искать ключевое слово в темах, телах, вложениях писем и т. Д. Но теперь мне просто нужно искать ключевое слово в содержимом вложений только в Outlook, есть идея? В этой статье приведены подробные инструкции по простому поиску слов в содержимом вложений в Outlook.

Сохранять вложения при ответе в Outlook
Когда мы пересылаем сообщение электронной почты в Microsoft Outlook, исходные вложения в этом сообщении электронной почты остаются в перенаправленном сообщении. Однако, когда мы отвечаем на сообщение электронной почты, исходные вложения не будут прикреплены к новому ответному сообщению. Здесь мы собираемся познакомить вас с парочкой приемов сохранения исходных вложений при ответе в Microsoft Outlook.


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

Kutools for Outlook - Более 100 мощных функций для улучшения вашего Outlook

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

???? Автоматизация электронной почты: Нет на месте (доступно для POP и IMAP)  /  Расписание отправки писем  /  Автоматическое копирование/скрытая копия по правилам при отправке электронной почты  /  Автопересылка (расширенные правила)   /  Автоматическое добавление приветствия   /  Автоматически разделять электронные письма от нескольких получателей на отдельные сообщения ...

📨 Управление электронной почтой: Легко вспоминать электронные письма  /  Блокировка мошеннических писем от субъектов и других лиц  /  Удалить повторяющиеся электронные письма  /  Поиск  /  Объединение папок ...

📁 Вложения ProПакетное сохранение  /  Пакетное отсоединение  /  Пакетное сжатие  /  Автосохранение   /  Авто отсоединение  /  Автоматическое сжатие ...

???? Магия интерфейса: 😊Больше красивых и крутых смайлов   /  Повысьте производительность Outlook с помощью представлений с вкладками  /  Свернуть Outlook вместо закрытия ...

???? Чудеса в один клик: Ответить всем с входящими вложениями  /   Антифишинговые письма  /  🕘Показать часовой пояс отправителя ...

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

Более Особенности 100 Ждем вашего исследования! Нажмите здесь, чтобы узнать больше.

 

 

Comments (81)
Rated 3.5 out of 5 · 3 ratings
This comment was minimized by the moderator on the site
Thank you for sharing the code. Unfortunately, I tried both with failure. This is what I got - The macros in this project are disabled. Please refer to the online help or documentation of the host application to determine how to enable macros. Thank you.
This comment was minimized by the moderator on the site
Hi,
Please follow the instructions in the screenshot below to check if macros are enabled in the macro settings in your Outlook. After enabling both options, re-run the VBA code.

https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/macro-enabled.png
This comment was minimized by the moderator on the site
Thank you so much.
Rated 5 out of 5
This comment was minimized by the moderator on the site
Thank you for sharing VBA code. This work like magic and is going to save it lots of time!
This comment was minimized by the moderator on the site
Hello friends!

Thanks for sharing this VBA code.

Is there any way to change the location of the save folder?

I share the pc with some colleagues and in this case I need the files to be saved in a password protected folder which is not located in the documents folder.

How can I make this change?

Thank you in advance
This comment was minimized by the moderator on the site
Hi Fabiana,
Change the line 14
xFolderPath = xFolderPath & "\Attachments\"

to
xFolderPath = "C:\Users\Win10x64Test\Desktop\save attachments\1\"

Here "C:\Users\Win10x64Test\Desktop\save attachments\1\" is the folder path in my case.
Don't forget to end the folder path with a slash "\"
This comment was minimized by the moderator on the site
Hello friends!

Thank you for sharing that VBA code.

Is there any way to change the location of the save folder?

I share the pc with some colleagues and in this case I need the files to be saved in a password protected folder which is not located in the documents folder.

How can I make this change?

Thank you in advance
This comment was minimized by the moderator on the site
If you are trying to run the Code that renames duplicate files and keep getting a "User Type Not Defined" error message here is the code fixed. Instead of the "Dim xFso As FileSystemObject" on line 47 it should be "Dim xFso As Variant"
Also added a Message Box to appear at the end of data transfer.

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
MsgBoX prompt:="File Transfer Complete", Title:="Sweatyjalapenos tha Goat"
End Sub

Function FileRename(FilePath As String) As String
Dim xPath As String
Dim xFso As Variant
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
This comment was minimized by the moderator on the site
Very nice script as of 2022-10-19 works great, for me doesn't seem to change original message by adding text. The only thing I changed is I added message received date time to each file name with the following format so it would nicely sort by date time in Windows folder: "yyyy-mm-dd HH-mm-ss ".

Code:

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, xDateFormat 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
xDateFormat = Format(xMailItem.ReceivedTime, "yyyy-mm-dd HH-mm-ss ")
xFilePath = xFolderPath & xDateFormat & 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
This comment was minimized by the moderator on the site
Hi Oigo,
This is a very useful VBA script. Thank you for sharing it.
This comment was minimized by the moderator on the site
Hi crystal,

sorry for not being clear.

I was trying to use the code above mentioned. However, apparently I was doing something wrong. I was thinking that I might need to amend some parts in the code shown. For instance the path where to save the attachments and maybe some other parts. Therefore I was asking if you could share the code highlighting the parts which needs tailoring and how to tailor them.

Many thanks,
BR
This comment was minimized by the moderator on the site
Hi Rokkie,
Did you get any error prompt when the code runs? Or which line in your code is highlighted? I need more details so I can see where you can modify the code.
This comment was minimized by the moderator on the site
Hey crystal,

completeley new to this VBA. Can you share a code to use which shows where I have to amend with an example? As a Rookie it is a bit difficult to figure it out.

I am working via a Ctrix connection. Could this be a blocker for the macro?

Much appreaciate the help.
This comment was minimized by the moderator on the site
Hi Rookie,
Sorry I don't understand what you mean: "Can you share a code to use which shows where I have to amend with an example?"
And the code operates on selected emails in Outlook, Ctrix Connection does not block the macro.
This comment was minimized by the moderator on the site
Hi, I am running this Code 1 to extract .txt files from separate sub-folders of an inbox. It works great out of one sub-folder but not at all out of another sub-folder. I have tried forwarding the relevant email and attachment into other inboxes but no luck. The files are automatically generated and sent to the different sub-folders and only vary by a single letter in their title

Any help much is appreciated
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations