Как да запазя всички прикачени файлове от множество имейли в папка в Outlook?

Лесно е да запазите всички прикачени файлове от имейл с вградената функция за запазване на всички прикачени файлове в Outlook. Ако обаче искате да запазите всички прикачени файлове от няколко имейла наведнъж, няма директна функция, която да ви помогне. Трябва многократно да прилагате функцията Запазване на всички прикачени файлове във всеки имейл, докато всички прикачени файлове бъдат запазени от тези имейли. Това отнема много време. В тази статия представяме два метода за масово запазване на всички прикачени файлове от множество имейли в конкретна папка лесно в Outlook.

Запазете всички прикачени файлове от множество имейли в папка с VBA код
Няколко кликвания за запазване на всички прикачени файлове от множество имейли в папка с невероятен инструмент

Запазете всички прикачени файлове от множество имейли в папка с VBA код

Този раздел демонстрира VBA код в ръководство стъпка по стъпка, за да ви помогне бързо да запазите всички прикачени файлове от множество имейли в конкретна папка наведнъж. Моля, направете следното.

1. Първо, трябва да създадете папка за запазване на прикачените файлове във вашия компютър.

Влезте в Документи папка и създайте папка с име „Прикачени файлове“. Вижте екранна снимка:

2. Изберете имейлите, чиито прикачени файлове ще запазите, и след това натиснете Друг + F11 за да отворите Microsoft Visual Basic за приложения прозорец.

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

бележки:

5. Натисни F5 ключ за изпълнение на кода.

След това всички прикачени файлове в избрани имейли се записват в папката, която сте създали в стъпка 1. 

Забележки: Може да има Microsoft Outlook изскачащо поле за подкана, моля, щракнете върху Позволете бутон, за да продължите напред.

Запазете всички прикачени файлове от множество имейли в папка с невероятен инструмент

Ако сте начинаещ във VBA, тук силно препоръчваме Запазване на всички прикачени файлове полезност на Kutools за Outook за теб. С тази помощна програма можете бързо да запазите всички прикачени файлове от множество имейли наведнъж с няколко кликвания само в Outlook.
Преди да приложите функцията, моля първо изтеглете и инсталирайте Kutools за Outlook.

1. Изберете имейлите, съдържащи прикачените файлове, които искате да запазите.

Съвет: Можете да изберете множество несъседни имейли, като задържите Ctrl клавиш и ги изберете един по един;
Или изберете няколко съседни имейла, като задържите Превключване и изберете първия имейл и последния.

2. кликване Kutools >Инструменти за прикачване > Запазване на всички. Вижте екранна снимка:

3. В Запазване на настройките диалогов прозорец, щракнете върху за да изберете папка за запазване на прикачените файлове и след това щракнете върху OK бутон.

3. кликване OK два пъти в следващия изскачащ диалогов прозорец, след което всички прикачени файлове в избраните имейли се записват в определена папка наведнъж.

Забележки:

• 1. Ако искате да запазвате прикачени файлове в различни папки въз основа на имейли, моля, проверете Създайте подпапки в следния стил и изберете стил на папка от падащото меню.
• 2. Освен запазване на всички прикачени файлове, можете да запазвате прикачени файлове по определени условия. Например, искате да запазите само прикачените файлове в pdf файл, чието име съдържа думата „Фактура“, моля, щракнете върху Разширени опции бутон, за да разширите условията, и след това конфигурирайте, както е показано на екранната снимка по-долу.
  
• 3. Ако искате автоматично да запазвате прикачени файлове при получаване на имейл, Автоматично запазване на прикачени файлове функция може да помогне.
• 4. За отделяне на прикачените файлове директно от избрани имейли, Откачете всички прикачени файлове функция на Kutools за Outlook може да ви направи услуга.

Свързани статии

---

Най-добрите инструменти за продуктивност в офиса

Kutools за Outlook - Над 100 мощни функции, за да заредите вашия Outlook

🤖 AI Mail Assistant: Незабавни професионални имейли с AI магия - с едно щракване до гениални отговори, перфектен тон, многоезично владеене. Трансформирайте имейла без усилие! ...

📧 Автоматизиране на имейли: Извън офиса (налично за POP и IMAP)  /  График за изпращане на имейли  /  Автоматично CC/BCC по правила при изпращане на имейл  /  Автоматично пренасочване (разширени правила)   /  Автоматично добавяне на поздрав   /  Автоматично разделяне на имейлите с множество получатели на отделни съобщения ...

📨 Управление на Email: Лесно извикване на имейли  /  Блокиране на измамни имейли по теми и други  /  Изтриване на дублирани имейли  /  подробно търсене  /  Консолидиране на папки ...

📁 Прикачени файлове Pro: Пакетно запазване  /  Партидно отделяне  /  Партиден компрес  /  Автоматично запазване   /  Автоматично отделяне  /  Автоматично компресиране ...

🌟 Магия на интерфейса: 😊 Още красиви и готини емотикони   /  Увеличете продуктивността на Outlook с изгледи с раздели  /  Минимизирайте Outlook, вместо да затваряте ...

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

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

Над 100 Характеристики Очаквайте вашето проучване! Щракнете тук, за да откриете повече.

Вижте повече       Безплатно сваляне      покупка