Hvordan gemmes alle vedhæftede filer fra flere e-mails til mappen i Outlook?

Det er nemt at gemme alle vedhæftede filer fra en e-mail med den indbyggede funktion Gem alle vedhæftede filer i Outlook. Men hvis du vil gemme alle vedhæftede filer fra flere e-mails på én gang, er der ingen direkte funktion, der kan hjælpe. Du skal gentagne gange anvende funktionen Gem alle vedhæftede filer i hver e-mail, indtil alle vedhæftede filer gemmes fra disse e-mails. Det er tidskrævende. I denne artikel introducerer vi to metoder, så du nemt kan gemme alle vedhæftede filer fra flere e-mails til en bestemt mappe i Outlook.

Gem alle vedhæftede filer fra flere e-mails til mappen med VBA-kode
Flere klik for at gemme alle vedhæftede filer fra flere e-mails til mappen med et fantastisk værktøj

Gem alle vedhæftede filer fra flere e-mails til mappen med VBA-kode

Dette afsnit demonstrerer en VBA-kode i en trinvis vejledning, der hjælper dig med hurtigt at gemme alle vedhæftede filer fra flere e-mails til en bestemt mappe på én gang. Gør som følger.

1. For det første skal du oprette en mappe til at gemme vedhæftede filer på din computer.

Kom ind i Dokumenter mappe og opret en mappe med navnet “Vedhæftede filer”. Se skærmbillede:

2. Vælg de e-mails, som de vedhæftede filer, du vil gemme, og tryk derefter på andre + F11 nøgler til at åbne Microsoft Visual Basic til applikationer vindue.

3. klik indsatte > Moduler at åbne Moduler vindue, og kopier derefter en af ​​følgende VBA-koder i vinduet.

VBA-kode 1: Bulk gem vedhæftede filer fra flere e-mails (gem vedhæftede filer med samme navn direkte)

Tips: Denne kode gemmer nøjagtigt samme vedhæftede navn ved at tilføje cifre 1, 2, 3 ... efter filnavne.

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-kode 2: Gem vedhæftede filer fra flere e-mails (tjek for dubletter)

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

Noter:

5. Tryk på F5 nøgle for at køre koden.

Derefter gemmes alle vedhæftede filer i valgte e-mails i den mappe, du oprettede i trin 1. 

Bemærkninger: Der kan være en Microsoft Outlook hurtig boks dukker op, skal du klikke på Tillad knappen for at gå videre.

Gem alle vedhæftede filer fra flere e-mails til mappen med et fantastisk værktøj

Hvis du er nybegynder i VBA, anbefales det stærkt Gem alle vedhæftede filer nytte af Kutools til Outook for dig. Med dette værktøj kan du hurtigt gemme alle vedhæftede filer fra flere e-mails på én gang med flere klik kun i Outlook.
Inden du anvender funktionen, bedes du venligst download og installer Kutools til Outlook først.

1. Vælg de e-mails, der indeholder de vedhæftede filer, du vil gemme.

tips: Du kan vælge flere ikke-tilstødende e-mails ved at holde Ctrl tast og vælg dem en efter en;
Eller vælg flere tilstødende e-mails ved at holde nede Flytte tasten, og vælg den første e-mail og den sidste.

2. klik Kutools >Vedhæftningsværktøjer > Gem alle. Se skærmbillede:

3. i Gem indstillinger dialog, klik på for at vælge en mappe, der skal gemmes vedhæftede filer, og klik derefter på OK .

3. klik OK to gange i den næste dukker op til dialogboksen, så gemmes alle vedhæftede filer i valgte e-mails i den angivne mappe på én gang.

Bemærkninger:

• 1. Hvis du vil gemme vedhæftede filer i forskellige mapper baseret på e-mails, skal du kontrollere Opret undermapper i følgende stil og vælg en mappestil fra rullemenuen.
• 2. Udover at gemme alle vedhæftede filer, kan du gemme vedhæftede filer under bestemte betingelser. For eksempel vil du kun gemme pdf-vedhæftede filer, som filnavnet indeholder ordet "Faktura", klik venligst på Avancerede indstillinger -knappen for at udvide betingelserne og derefter konfigurere som nedenstående skærmbillede vist.
  
• 3. Hvis du automatisk vil gemme vedhæftede filer, når du modtager e-mail, vises Gem vedhæftede filer automatisk funktion kan hjælpe.
• 4. For at fjerne vedhæftede filer direkte fra valgte e-mails, Fjern alle vedhæftede filer træk ved Kutools til Outlook kan gøre dig en tjeneste.

Relaterede artikler

---

Bedste kontorproduktivitetsværktøjer

Kutools til Outlook - Over 100 kraftfulde funktioner til at superlade din Outlook

🤖 AI Mail Assistant: Øjeblikkelige pro-e-mails med AI-magi – et klik for geniale svar, perfekt tone, flersproget beherskelse. Forvandl e-mailing ubesværet! ...

📧 Email Automation: Ikke til stede (tilgængelig til POP og IMAP)  /  Planlæg Send e-mails  /  Auto CC/BCC efter regler ved afsendelse af e-mail  /  Automatisk videresendelse (avancerede regler)   /  Tilføj automatisk hilsen   /  Opdel automatisk e-mails med flere modtagere i individuelle meddelelser ...

📨 Email Management: Genkald nemt e-mails  /  Bloker svindel-e-mails af emner og andre  /  Slet duplikerede e-mails  /  Avanceret søgning  /  Konsolider mapper ...

📁 Vedhæftede filer Pro: Batch Gem  /  Batch adskilles  /  Batch komprimere  /  Automatisk gem   /  Automatisk afmontering  /  Automatisk komprimering ...

🌟 Interface Magic: 😊 Flere smukke og seje emojis   /  Boost din Outlook-produktivitet med fanebaserede visninger  /  Minimer Outlook i stedet for at lukke ...

👍 Wonders med et enkelt klik: Besvar alle med indgående vedhæftede filer  /   Anti-phishing e-mails  /  🕘Vis afsenderens tidszone ...

👩🏼‍🤝‍👩🏻 Kontakter og kalender: Batch Tilføj kontakter fra udvalgte e-mails  /  Opdel en kontaktgruppe til individuelle grupper  /  Fjern fødselsdagspåmindelser ...

Over 100 Features Afvent din udforskning! Klik her for at finde mere.

Læs mere       Gratis download      Køb