Vai al contenuto principale

Come salvare tutti gli allegati da più e-mail nella cartella in Outlook?

È facile salvare tutti gli allegati da un'e-mail con la funzione Salva tutti gli allegati incorporata in Outlook. Tuttavia, se desideri salvare tutti gli allegati da più e-mail contemporaneamente, non è disponibile alcuna funzione diretta. È necessario applicare ripetutamente la funzione Salva tutti gli allegati in ogni e-mail fino a quando tutti gli allegati non vengono salvati da tali e-mail. Questo richiede tempo. In questo articolo, introduciamo due metodi per salvare in blocco tutti gli allegati da più e-mail in una cartella specifica facilmente in Outlook.

Salva tutti gli allegati da più email nella cartella con il codice VBA
Diversi clic per salvare tutti gli allegati da più e-mail in una cartella con uno strumento straordinario


Salva tutti gli allegati da più email nella cartella con il codice VBA

Questa sezione mostra un codice VBA in una guida passo passo per aiutarti a salvare rapidamente tutti gli allegati da più email in una cartella specifica contemporaneamente. Si prega di fare quanto segue.

1. Innanzitutto, è necessario creare una cartella per salvare gli allegati nel computer.

Entra nel Documenti cartella e creare una cartella denominata "Allegati". Visualizza gli screenshot:

2. Selezionare i messaggi di posta elettronica che verranno salvati negli allegati, quindi premere altro + F11 chiavi per aprire il Microsoft Visual Basic, Applications Edition finestra.

3. Clic inserire > Moduli per aprire il Moduli finestra, quindi copia uno dei seguenti codice VBA nella finestra.

Codice VBA 1: salva in blocco gli allegati da più e-mail (salva direttamente gli allegati con lo stesso nome)

Suggerimenti:: Questo codice salverà gli allegati con lo stesso nome aggiungendo le cifre 1, 2, 3 ... dopo i nomi dei file.

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
Codice VBA 2: salva in blocco gli allegati da più e-mail (controlla i duplicati)
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

Note:

1) Se si desidera salvare tutti gli allegati con lo stesso nome in una cartella, applicare quanto sopra Codice VBA 1. Prima di eseguire questo codice, fare clic su Strumenti > Riferimentie quindi controllare il Runtime di script Microsoft casella nella Riferimenti - Progetto la finestra di dialogo;

doc salva allegati 07

2) Se si desidera verificare la presenza di nomi di allegati duplicati, applicare il codice VBA 2. Dopo aver eseguito il codice, verrà visualizzata una finestra di dialogo per ricordare se sostituire gli allegati duplicati, scegliere or Non in base alle proprie esigenze.

5. premi il F5 chiave per eseguire il codice.

Quindi tutti gli allegati nelle e-mail selezionate vengono salvati nella cartella creata nel passaggio 1. 

Note: Potrebbe esserci un Microsoft Outlook finestra di messaggio che si apre, fare clic su Consentire pulsante per andare avanti.


Salva tutti gli allegati da più email in una cartella con uno strumento straordinario

Se sei un principiante in VBA, qui altamente raccomandato il Salva tutti gli allegati utilità di Kutools per Outook per te. Con questa utility, puoi salvare rapidamente tutti gli allegati da più e-mail contemporaneamente con diversi clic solo in Outlook.
Prima di applicare la funzione, per favore scarica e installa prima Kutools per Outlook.

1. Selezionare le e-mail contenenti gli allegati che si desidera salvare.

Suggerimenti: Puoi selezionare più email non adiacenti tenendo premuto il tasto Ctrl tasto e selezionarli uno per uno;
Oppure seleziona più email adiacenti tenendo premuto il tasto Shift e seleziona la prima e-mail e l'ultima.

2. Clic Kutools >Strumenti per gli allegatiSalva tutto. Vedi screenshot:

3. Nel Salva impostazioni finestra di dialogo, fare clic su per selezionare una cartella in cui salvare gli allegati, quindi fare clic su OK pulsante.

3. Clic OK due volte nella successiva finestra di dialogo, quindi tutti gli allegati nelle e-mail selezionate vengono salvati nella cartella specificata contemporaneamente.

Note:

  • 1. Se desideri salvare gli allegati in cartelle diverse in base alle e-mail, controlla il file Crea sottocartelle nel seguente stile casella e scegli uno stile di cartella dal menu a discesa.
  • 2. Oltre a salvare tutti gli allegati, è possibile salvare gli allegati in base a condizioni specifiche. Ad esempio, si desidera salvare solo gli allegati del file pdf il cui nome del file contiene la parola "Fattura", fare clic sul pulsante Opzioni avanzate per espandere le condizioni, quindi configurare come mostrato di seguito.
  • 3. Se si desidera salvare automaticamente gli allegati all'arrivo di messaggi di posta elettronica, il file Salvataggio automatico degli allegati la funzione può aiutare.
  • 4. Per scollegare gli allegati direttamente dalle e-mail selezionate, il file Scollega tutti gli allegati caratteristica di Kutools for Outlook puoi farti un favore

  Se desideri avere una prova gratuita (60 giorni) di questa utility, fare clic per scaricarlo, quindi andare ad applicare l'operazione secondo i passaggi precedenti.


Articoli correlati

Inserisci allegati nel corpo del messaggio di posta elettronica in Outlook
Normalmente gli allegati vengono visualizzati nel campo Allegati in un'e-mail di composizione. Qui questo tutorial fornisce metodi per aiutarti a inserire facilmente allegati nel corpo dell'email in Outlook.

Scarica / salva automaticamente gli allegati da Outlook in una determinata cartella
In generale, puoi salvare tutti gli allegati di un'e-mail facendo clic su Allegati> Salva tutti gli allegati in Outlook. Ma se è necessario salvare tutti gli allegati da tutte le e-mail ricevute e ricevute, qualsiasi ideale? Questo articolo introdurrà due soluzioni per scaricare automaticamente gli allegati da Outlook in una determinata cartella.

Stampa tutti gli allegati in una / più email in Outlook
Come sai, stamperà solo il contenuto dell'email come intestazione, corpo quando fai clic su File> Stampa in Microsoft Outlook, ma non stampa gli allegati. Qui ti mostreremo come stampare facilmente tutti gli allegati in un'e-mail selezionata in Microsoft Outlook.

Cerca parole all'interno dell'allegato (contenuto) in Outlook
Quando digitiamo una parola chiave nella casella di ricerca istantanea in Outlook, cercherà la parola chiave nell'oggetto, nel corpo, negli allegati delle email, ecc. Ma ora devo solo cercare la parola chiave nel contenuto degli allegati solo in Outlook, idea? Questo articolo mostra i passaggi dettagliati per cercare facilmente le parole all'interno del contenuto degli allegati in Outlook.

Conserva gli allegati quando rispondi in Outlook
Quando inoltriamo un messaggio di posta elettronica in Microsoft Outlook, gli allegati originali in questo messaggio di posta elettronica rimangono nel messaggio inoltrato. Tuttavia, quando rispondiamo a un messaggio di posta elettronica, gli allegati originali non verranno allegati nel nuovo messaggio di risposta. Qui introdurremo un paio di trucchi per mantenere gli allegati originali quando si risponde in Microsoft Outlook.


I migliori strumenti per la produttività in ufficio

Kutools for Outlook - Oltre 100 potenti funzionalità per potenziare il tuo Outlook

🤖 Assistente di posta AI: E-mail istantanee professionali con la magia dell'intelligenza artificiale: risposte geniali con un solo clic, tono perfetto, padronanza multilingue. Trasforma l'e-mail senza sforzo! ...

???? Automazione di posta elettronica: Fuori sede (disponibile per POP e IMAP)  /  Pianifica l'invio di e-mail  /  CC/BCC automatico in base alle regole durante l'invio di e-mail  /  Inoltro automatico (regole avanzate)   /  Aggiunta automatica di saluto   /  Suddividi automaticamente le email con più destinatari in singoli messaggi ...

📨 gestione e-mail: Richiama facilmente le email  /  Blocca le email truffe per soggetto e altri  /  Elimina email duplicate  /  Ricerca avanzata  /  Consolidare cartelle ...

📁 Allegati ProSalvataggio in batch  /  Stacca batch  /  Comprimi in lotti  /  Salvataggio automatico   /  Scollegamento automatico  /  Comprimi automaticamente ...

🌟 Magia dell'interfaccia: 😊Più emoji carini e fantastici   /  Aumenta la tua produttività in Outlook con le visualizzazioni a schede  /  Riduci a icona Outlook invece di chiuderlo ...

👍 Meraviglie con un clic: Rispondi a tutti con gli allegati in arrivo  /   E-mail anti-phishing  /  🕘Mostra il fuso orario del mittente ...

👩🏼‍🤝‍👩🏻 Contatti e calendario: Aggiungi in batch contatti dalle email selezionate  /  Dividere un gruppo di contatti in singoli gruppi  /  Rimuovi promemoria compleanno ...

Al di sopra Caratteristiche 100 Attendi la tua esplorazione! Clicca qui per scoprire di più.

 

 

Comments (81)
Rated 3.5 out of 5 · 3 ratings
This comment was minimized by the moderator on the site
Thank you for sharing the code. Unfortunately, I tried both with failure. This is what I got - The macros in this project are disabled. Please refer to the online help or documentation of the host application to determine how to enable macros. Thank you.
This comment was minimized by the moderator on the site
Hi,
Please follow the instructions in the screenshot below to check if macros are enabled in the macro settings in your Outlook. After enabling both options, re-run the VBA code.

https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/macro-enabled.png
This comment was minimized by the moderator on the site
Thank you so much.
Rated 5 out of 5
This comment was minimized by the moderator on the site
Thank you for sharing VBA code. This work like magic and is going to save it lots of time!
This comment was minimized by the moderator on the site
Hello friends!

Thanks for sharing this VBA code.

Is there any way to change the location of the save folder?

I share the pc with some colleagues and in this case I need the files to be saved in a password protected folder which is not located in the documents folder.

How can I make this change?

Thank you in advance
This comment was minimized by the moderator on the site
Hi Fabiana,
Change the line 14
xFolderPath = xFolderPath & "\Attachments\"

to
xFolderPath = "C:\Users\Win10x64Test\Desktop\save attachments\1\"

Here "C:\Users\Win10x64Test\Desktop\save attachments\1\" is the folder path in my case.
Don't forget to end the folder path with a slash "\"
This comment was minimized by the moderator on the site
Hello friends!

Thank you for sharing that VBA code.

Is there any way to change the location of the save folder?

I share the pc with some colleagues and in this case I need the files to be saved in a password protected folder which is not located in the documents folder.

How can I make this change?

Thank you in advance
This comment was minimized by the moderator on the site
If you are trying to run the Code that renames duplicate files and keep getting a "User Type Not Defined" error message here is the code fixed. Instead of the "Dim xFso As FileSystemObject" on line 47 it should be "Dim xFso As Variant"
Also added a Message Box to appear at the end of data transfer.

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
MsgBoX prompt:="File Transfer Complete", Title:="Sweatyjalapenos tha Goat"
End Sub

Function FileRename(FilePath As String) As String
Dim xPath As String
Dim xFso As Variant
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
This comment was minimized by the moderator on the site
Very nice script as of 2022-10-19 works great, for me doesn't seem to change original message by adding text. The only thing I changed is I added message received date time to each file name with the following format so it would nicely sort by date time in Windows folder: "yyyy-mm-dd HH-mm-ss ".

Code:

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, xDateFormat 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
xDateFormat = Format(xMailItem.ReceivedTime, "yyyy-mm-dd HH-mm-ss ")
xFilePath = xFolderPath & xDateFormat & 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
This comment was minimized by the moderator on the site
Hi Oigo,
This is a very useful VBA script. Thank you for sharing it.
This comment was minimized by the moderator on the site
Hi crystal,

sorry for not being clear.

I was trying to use the code above mentioned. However, apparently I was doing something wrong. I was thinking that I might need to amend some parts in the code shown. For instance the path where to save the attachments and maybe some other parts. Therefore I was asking if you could share the code highlighting the parts which needs tailoring and how to tailor them.

Many thanks,
BR
This comment was minimized by the moderator on the site
Hi Rokkie,
Did you get any error prompt when the code runs? Or which line in your code is highlighted? I need more details so I can see where you can modify the code.
This comment was minimized by the moderator on the site
Hey crystal,

completeley new to this VBA. Can you share a code to use which shows where I have to amend with an example? As a Rookie it is a bit difficult to figure it out.

I am working via a Ctrix connection. Could this be a blocker for the macro?

Much appreaciate the help.
This comment was minimized by the moderator on the site
Hi Rookie,
Sorry I don't understand what you mean: "Can you share a code to use which shows where I have to amend with an example?"
And the code operates on selected emails in Outlook, Ctrix Connection does not block the macro.
This comment was minimized by the moderator on the site
Hi, I am running this Code 1 to extract .txt files from separate sub-folders of an inbox. It works great out of one sub-folder but not at all out of another sub-folder. I have tried forwarding the relevant email and attachment into other inboxes but no luck. The files are automatically generated and sent to the different sub-folders and only vary by a single letter in their title

Any help much is appreciated
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations