Cum se salvează toate atașamentele de la mai multe e-mailuri în dosar în Outlook?

Este ușor să salvați toate atașamentele dintr-un e-mail cu funcția integrată Salvați toate atașamentele din Outlook. Cu toate acestea, dacă doriți să salvați toate atașamentele din mai multe e-mailuri simultan, nu există nicio funcție directă care vă poate ajuta. Trebuie să aplicați în mod repetat caracteristica Salvați toate atașamentele în fiecare e-mail până când toate atașamentele sunt salvate din aceste e-mailuri. Asta consumă mult timp. În acest articol, vă introducem două metode pentru a salva în bloc toate atașamentele de la mai multe e-mailuri într-un folder specific cu ușurință în Outlook.

Salvați toate atașamentele din mai multe e-mailuri în folderul cu cod VBA
Mai multe clicuri pentru a salva toate atașamentele din mai multe e-mailuri în dosar cu un instrument uimitor

Salvați toate atașamentele din mai multe e-mailuri în folderul cu cod VBA

Această secțiune prezintă un cod VBA într-un ghid pas cu pas pentru a vă ajuta să salvați rapid toate atașamentele de la mai multe e-mailuri într-un folder specific simultan. Vă rugăm să faceți următoarele.

1. În primul rând, trebuie să creați un folder pentru salvarea atașamentelor în computer.

Intră în Documente folder și creați un folder numit „Atașamente”. Vedeți captura de ecran:

2. Selectați e-mailurile pe care le veți salva atașamentele, apoi apăsați Alt + F11 tastele pentru a deschide Microsoft Visual Basic pentru aplicații fereastră.

3. clic Insera > Module pentru a deschide Module fereastră, apoi copiați unul din următorul cod VBA în fereastră.

Cod VBA 1: Salvați atașamente în bloc din mai multe e-mailuri (salvați direct atașamente cu același nume)

sfaturi: Acest cod va salva atașamente cu același nume, adăugând cifrele 1, 2, 3 ... după numele fișierelor.

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

Cod VBA 2: Salvați în bloc atașamente din mai multe e-mailuri (verificați dacă există duplicate)

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

notițe:

5. apasă pe F5 tasta pentru a rula codul.

Apoi, toate atașamentele din e-mailurile selectate sunt salvate în folderul creat la pasul 1. 

note: Poate exista Microsoft Outlook caseta de prompt apare, vă rugăm să faceți clic pe Permite pentru a merge mai departe.

Salvați toate atașamentele din mai multe e-mailuri în dosar cu un instrument uimitor

Dacă sunteți un începător în VBA, aici vă recomandăm cu tărie Salvați toate atașamentele utilitatea Kutools pentru Outook Pentru dumneavoastră. Cu acest utilitar, puteți salva rapid toate atașamentele din mai multe e-mailuri simultan cu mai multe clicuri numai în Outlook.
Înainte de a aplica funcția, vă rugăm descărcați și instalați mai întâi Kutools pentru Outlook.

1. Selectați e-mailurile care conțin atașamentele pe care doriți să le salvați.

Sfat: Puteți selecta mai multe e-mailuri neadiacente apăsând pe Ctrl tasta și selectați-le unul câte unul;
Sau selectați mai multe e-mailuri adiacente ținând apăsat butonul Schimba tasta și selectați primul e-mail și ultimul.

2. clic Kutools >Instrumente de atașare > Salvează tot. Vedeți captura de ecran:

3. În Salvează Setările , faceți clic pe pentru a selecta un folder pentru a salva atașamentele, apoi faceți clic pe OK butonul.

3. clic OK de două ori în următoarea fereastră care apare în caseta de dialog, Apoi toate atașamentele din e-mailurile selectate sunt salvate simultan în folderul specificat.

note:

• 1. Dacă doriți să salvați atașamente în diferite foldere pe baza e-mailurilor, vă rugăm să verificați Creați subfoldere în stilul următor și alegeți un stil de folder din meniul derulant.
• 2. Pe lângă salvarea tuturor atașamentelor, puteți salva atașamentele în anumite condiții. De exemplu, doriți doar să salvați fișierele atașate pdf în care numele fișierului conține cuvântul „Factură”, faceți clic pe Opţiuni avansate pentru a extinde condițiile, apoi configurați-l după cum se arată în imaginea de mai jos.
  
• 3. Dacă doriți să salvați automat atașamente la sosirea e-mailului, fișierul Salvați automat atașamentele caracteristica poate ajuta.
• 4. Pentru detașarea atașamentelor direct din e-mailurile selectate, fișierul Desprindeți toate atașamentele caracteristică a Kutools pentru Outlook vă poate face o favoare.

Articole pe aceeași temă

---

Cele mai bune instrumente de productivitate de birou

Kutools pentru Outlook - Peste 100 de funcții puternice pentru a vă supraalimenta Outlook

🤖 AI Mail Assistant: E-mailuri profesionale instantanee cu magie AI--un singur clic pentru răspunsuri geniale, ton perfect, stăpânire în mai multe limbi. Transformați e-mailurile fără efort! ...

📧 Automatizare e-mail: În afara biroului (disponibil pentru POP și IMAP)  /  Programați trimiterea de e-mailuri  /  CC/BCC automat după reguli la trimiterea e-mailului  /  Redirecționare automată (Reguli avansate)   /  Adăugare automată felicitare   /  Împărțiți automat e-mailurile cu mai mulți destinatari în mesaje individuale ...

📨 Managementul e-mail: Amintește-ți cu ușurință e-mailurile  /  Blocați e-mailurile înșelătorii de către subiecți și alții  /  Ștergeți e-mailurile duplicate  /  Cautare Avansata  /  Consolidați foldere ...

📁 Atașamente Pro: Salvați în serie  /  Detașare lot  /  Compresă în loturi  /  Salvare automata   /  Detașare automată  /  Comprimare automată ...

🌟 Magia interfeței: 😊Mai multe emoji drăguțe și cool   /  Îmbunătățiți-vă productivitatea Outlook cu vizualizările cu file  /  Minimizați Outlook în loc să închideți ...

???? Minuni cu un singur clic: Răspundeți tuturor cu atașamentele primite  /   E-mailuri anti-phishing  /  🕘Afișați fusul orar al expeditorului ...

👩🏼‍🤝‍👩🏻 Contacte și calendar: Adăugați în lot contacte din e-mailurile selectate  /  Împărțiți un grup de contact în grupuri individuale  /  Eliminați mementouri de ziua de naștere ...

Peste 100 Caracteristici Așteaptă explorarea ta! Click aici pentru a descoperi mai multe.

Citeste mai mult       Descărcare gratuită      Cumpărare