Kako shraniti vse priloge iz več e-poštnih sporočil v mapo v Outlooku?

Vse vloge iz e-pošte lahko enostavno shranite z vgrajeno funkcijo Shrani vse priloge v Outlooku. Če pa želite shraniti vse priloge iz več e-poštnih sporočil hkrati, vam neposredna funkcija ne more pomagati. V vsakem e-poštnem sporočilu morate večkrat uporabiti funkcijo Shrani vse priloge, dokler se iz teh e-poštnih sporočil ne shranijo vse priloge. To je zamudno. V tem članku vam predstavljamo dva načina za enostavno shranjevanje vseh prilog iz več e-poštnih sporočil v določeno mapo v Outlooku.

Shranite vse priloge iz več e-poštnih sporočil v mapo s kodo VBA
Več klikov, da shranite vse priloge iz več e-poštnih sporočil v mapo z neverjetnim orodjem

Shranite vse priloge iz več e-poštnih sporočil v mapo s kodo VBA

Ta razdelek prikazuje kodo VBA v vodniku po korakih, ki vam pomaga hitro shraniti vse priloge iz več e-poštnih sporočil naenkrat v določeno mapo. Naredite naslednje.

1. Najprej morate ustvariti mapo za shranjevanje prilog v računalniku.

Pojdi v dokumenti mapo in ustvarite mapo z imenom “Priloge”. Oglejte si posnetek zaslona:

2. Izberite e-poštna sporočila, ki jih boste shranili, in pritisnite druga + F11 tipke za odpiranje Microsoft Visual Basic za aplikacije okno.

3. klik Vstavi > Moduli da odprete Moduli in nato v okno kopirajte eno od naslednjih kod VBA.

Koda VBA 1: množično shranjevanje prilog iz več e-poštnih sporočil (priloge z enakim imenom shranite neposredno)

nasveti: Ta koda bo shranila popolnoma enake priloge z dodajanjem številk 1, 2, 3 ... za imeni datotek.

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

Koda VBA 2: množično shranjevanje prilog iz več e-poštnih sporočil (preverite, ali obstajajo dvojniki)

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

Opombe:

5. Pritisnite F5 tipko za zagon kode.

Nato se vse priloge v izbranih e-poštnih sporočilih shranijo v mapo, ki ste jo ustvarili v 1. koraku. 

Opombe: Lahko se pojavi a Microsoft Outlook Pojavi se pozivno okno, kliknite na Dovoli gumb za naprej.

Shranite vse priloge iz več e-poštnih sporočil v mapo z neverjetnim orodjem

Če ste novinec v VBA, tukaj toplo priporočam Shrani vse priloge uporabnost Kutools za Outook zate. S tem pripomočkom lahko hitro shranite vse priloge iz več e-poštnih sporočil hkrati z več kliki samo v Outlooku.
Pred uporabo funkcije prosim najprej naložite in namestite Kutools za Outlook.

1. Izberite e-poštna sporočila, ki vsebujejo priloge, ki jih želite shraniti.

Nasvet: Z držanjem gumba lahko izberete več sosednjih e-poštnih sporočil Ctrl tipko in jih izberite enega za drugim;
Ali pa izberite več sosednjih e-poštnih sporočil, tako da držite tipko Shift tipko in izberite prvo in zadnje e-poštno sporočilo.

2. klik Kutools >Orodja za pritrditev > Shrani vse. Oglejte si posnetek zaslona:

3. V Ljubljani Shrani nastavitve kliknite pogovorno okno , da izberete mapo, v katero želite shraniti priloge, in nato kliknite OK gumb.

3. klik OK dvakrat v naslednjem pojavnem oknu, nato se vse priloge v izbranih e-poštnih sporočilih hkrati shranijo v določeno mapo.

Opombe:

• 1. Če želite shraniti priloge v različne mape na podlagi e-pošte, preverite Ustvarite podmape v naslednjem slogu in v spustnem meniju izberite slog mape.
• 2. Poleg shranjevanja vseh prilog lahko priloge shranite tudi pod posebnimi pogoji. Na primer, shraniti želite samo priloge datotek pdf, v katerih ime datoteke vsebuje besedo "Račun", kliknite Dodatne možnosti , da razširite pogoje, in nato konfigurirajte, kot je prikazano na spodnji sliki zaslona.
  
• 3. Če želite samodejno shraniti priloge ob prihodu e-pošte, se Samodejno shrani priloge funkcija vam lahko pomaga.
• 4. Za odstranitev prilog neposredno iz izbranih e-poštnih sporočil se Odstranite vse priloge značilnost Kutools za Outlook ti lahko naredi uslugo.

Sorodni članki

---

Najboljša pisarniška orodja za produktivnost

Kutools za Outlook - Več kot 100 zmogljivih funkcij za nadgradnjo vašega Outlooka

🤖 AI poštni pomočnik: Takojšnja profesionalna e-poštna sporočila z umetno inteligenco – z enim klikom do genialnih odgovorov, popoln ton, večjezično znanje. Preoblikujte pošiljanje e-pošte brez napora! ...

📧 Avtomatizacija e-pošte: Odsoten (na voljo za POP in IMAP)  /  Načrtujte pošiljanje e-pošte  /  Samodejna CC/BCC po pravilih pri pošiljanju e-pošte  /  Samodejno naprej (napredna pravila)   /  Samodejno dodaj pozdrav   /  E-poštna sporočila več prejemnikov samodejno razdeli na posamezna sporočila ...

📨 Email upravljanje: Enostaven priklic e-pošte  /  Blokiraj prevarantska e-poštna sporočila glede na teme in druge  /  Izbriši podvojena e-poštna sporočila  /  napredno iskanje  /  Združite mape ...

📁 Priloge Pro: Shrani paket  /  Batch Detach  /  Paketno stiskanje  /  Samodejno shranite   /  Samodejno loči  /  Samodejno stiskanje ...

🌟 Vmesnik Magic: 😊Več lepih in kul emojijev   /  Povečajte Outlookovo produktivnost s pogledi z zavihki  /  Minimizirajte Outlook, namesto da bi ga zaprli ...

???? Čudeži z enim klikom: Odgovori vsem z dohodnimi prilogami  /   E-poštna sporočila proti lažnemu predstavljanju  /  🕘Pokaži pošiljateljev časovni pas ...

👩🏼‍🤝‍👩🏻 Stiki in koledar: Paketno dodajanje stikov iz izbranih e-poštnih sporočil  /  Razdelite skupino stikov na posamezne skupine  /  Odstranite opomnike za rojstni dan ...

Over 100 Lastnosti Čakajte na svoje raziskovanje! Kliknite tukaj, če želite odkriti več.

Preberi več       Brezplačen prenos      Nakup