Hur sparar jag alla bilagor från flera e-postmeddelanden till mappen i Outlook?

Det är enkelt att spara alla bilagor från ett e-postmeddelande med den inbyggda funktionen Spara alla bilagor i Outlook. Men om du vill spara alla bilagor från flera e-postmeddelanden samtidigt finns det ingen direktfunktion som kan hjälpa till. Du måste använda Spara alla bilagor upprepade gånger i varje e-postmeddelande tills alla bilagor sparas från dessa e-postmeddelanden. Det är tidskrävande. I den här artikeln introducerar vi två metoder för dig att enkelt spara alla bilagor från flera e-postmeddelanden till en viss mapp enkelt i Outlook.

Spara alla bilagor från flera e-postmeddelanden till mappen med VBA-kod
Flera klick för att spara alla bilagor från flera e-postmeddelanden till mappen med ett fantastiskt verktyg

Spara alla bilagor från flera e-postmeddelanden till mappen med VBA-kod

Detta avsnitt visar en VBA-kod i en steg-för-steg-guide som hjälper dig att snabbt spara alla bilagor från flera e-postmeddelanden till en viss mapp samtidigt. Gör så här.

1. För det första måste du skapa en mapp för att spara bilagorna på din dator.

Get into those Dokument mapp och skapa en mapp med namnet “Bilagor”. Se skärmdump:

2. Välj e-postmeddelandena som bilagorna du vill spara och tryck sedan på andra + F11 nycklar för att öppna Microsoft Visual Basic för applikationer fönster.

3. klick Insert > Modulerna att öppna Modulerna och kopiera sedan en av följande VBA-koder till fönstret.

VBA-kod 1: Massspara bilagor från flera e-postmeddelanden (spara bilagor med exakt samma namn direkt)

tips: Den här koden sparar exakt samma namnbilagor genom att lägga till siffror 1, 2, 3 ... efter filnamn.

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-kod 2: Massspara bilagor från flera e-postmeddelanden (leta efter dubbletter)

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

Anmärkningar:

5. tryck på F5 för att köra koden.

Sedan sparas alla bilagor i valda e-postmeddelanden i mappen du skapade i steg 1. 

Anmärkningar: Det kan finnas en Microsoft Outlook snabb rutan dyker upp, klicka på Tillåt knappen för att gå vidare.

Spara alla bilagor från flera e-postmeddelanden till mappen med ett fantastiskt verktyg

Om du är nybörjare i VBA, rekommenderas här starkt Spara alla bilagor nytta av Kutools för Outook till dig. Med det här verktyget kan du snabbt spara alla bilagor från flera e-postmeddelanden samtidigt med bara flera klick i Outlook.
Innan du använder funktionen, tack ladda ner och installera Kutools för Outlook först.

1. Välj e-postmeddelanden som innehåller bilagorna du vill spara.

Tips: Du kan välja flera icke-angränsande e-postmeddelanden genom att hålla ned ctrl och välj dem en efter en;
Eller välj flera intilliggande e-postmeddelanden genom att hålla ned shift och välj det första e-postmeddelandet och det sista.

2. klick Kutools >Tillbehörsverktyg > Spara alla. Se skärmdump:

3. I Spara inställningar dialogrutan, klicka på för att välja en mapp för att spara bilagorna och klicka sedan på OK knapp.

3. klick OK två gånger i nästa popp upp till dialogrutan, sedan sparas alla bilagor i valda e-postmeddelanden i angiven mapp samtidigt.

Anmärkningar:

• 1. Om du vill spara bilagor i olika mappar baserat på e-postmeddelanden, kontrollera Skapa undermappar i följande stil och välj en mappstil i rullgardinsmenyn.
• 2. Förutom att spara alla bilagor kan du spara bilagor enligt specifika villkor. Du vill till exempel bara spara bifogade pdf-filer som filnamnet innehåller ordet "Faktura", klicka på Avancerade alternativ -knappen för att utvidga villkoren och konfigurera sedan som bilden nedan visas.
  
• 3. Om du vill spara bilagor automatiskt när e-post anländer, kommer Spara bilagor automatiskt funktionen kan hjälpa.
• 4. För att ta bort bilagorna direkt från valda e-postmeddelanden, Lossa alla bilagor egenskap av Kutools för Outlook kan göra dig en tjänst.

Relaterade artiklar

---

Bästa kontorsproduktivitetsverktyg

Kutools för Outlook - Över 100 kraftfulla funktioner för att överladda din Outlook

🤖 AI Mail Assistant: Instant proffs-e-postmeddelanden med AI-magi – ett klick för geniala svar, perfekt ton, flerspråkig behärskning. Förvandla e-post utan ansträngning! ...

📧 Email Automation: Frånvaro (tillgänglig för POP och IMAP)  /  Schemalägg Skicka e-post  /  Auto CC/BCC enligt regler när du skickar e-post  /  Automatisk vidarebefordran (avancerade regler)   /  Lägg automatiskt till hälsning   /  Dela automatiskt e-postmeddelanden med flera mottagare i individuella meddelanden ...

📨 Email Management: Hämta enkelt e-postmeddelanden  /  Blockera bluff-e-postmeddelanden av ämnen och andra  /  Ta bort duplicerade e-postmeddelanden  /  Avancerad Sökning  /  Konsolidera mappar ...

📁 Bilagor Pro: Batch Spara  /  Batch lossa  /  Batchkomprimera  /  Automatisk sparning   /  Auto Lossa  /  Automatisk komprimering ...

🌟 Gränssnittsmagi: 😊 Fler vackra och coola emojis   /  Öka din Outlook-produktivitet med flikar  /  Minimera Outlook istället för att stänga ...

👍 Underverk med ett klick: Svara alla med inkommande bilagor  /   E-postmeddelanden mot nätfiske  /  🕘Visa avsändarens tidszon ...

👩🏼‍🤝‍👩🏻 Kontakter och kalender: Lägg till kontakter i grupp från valda e-postmeddelanden  /  Dela upp en kontaktgrupp till individuella grupper  /  Ta bort påminnelser om födelsedag ...

Över 100 funktioner Vänta på din utforskning! Klicka här för att upptäcka mer.

Läs mer       Gratis nedladdning      Inköp