Comment enregistrer toutes les pièces jointes de plusieurs e-mails dans un même dossier avec Outlook ?

Il est facile d’enregistrer toutes les pièces jointes d’un seul e-mail grâce à la fonction intégrée « Enregistrer toutes les pièces jointes » dans Outlook. Toutefois, si vous souhaitez enregistrer simultanément les pièces jointes de plusieurs e-mails, aucune fonction directe n’est disponible : vous devez répéter manuellement l’opération pour chaque message jusqu’à ce que toutes les pièces jointes soient sauvegardées — une tâche longue et fastidieuse. Cet article vous présente deux méthodes simples pour enregistrer en lot toutes les pièces jointes de plusieurs e-mails vers un dossier spécifique, directement depuis Outlook.

Enregistrer toutes les pièces jointes de plusieurs e-mails dans un dossier à l’aide d’un code VBA
Quelques clics pour enregistrer toutes les pièces jointes de plusieurs e-mails dans un dossier avec un outil exceptionnel

Enregistrer toutes les pièces jointes de plusieurs e-mails dans un dossier à l’aide d’un code VBA

Cette section vous guide pas à pas dans un code VBA conçu pour enregistrer rapidement toutes les pièces jointes de plusieurs e-mails dans un dossier spécifique, en une seule opération. Suivez ces étapes :

1. Commencez par créer un dossier sur votre ordinateur pour y enregistrer les pièces jointes.

Accédez au dossier « Documents » et créez-y un sous-dossier intitulé « Pièces jointes ». Voir la capture d’écran :

2. Sélectionnez les e-mails dont vous souhaitez enregistrer les pièces jointes, puis appuyez sur les touches « Alt » + « F11 » pour ouvrir la fenêtre « Microsoft Visual Basic pour Applications ».

3. Cliquez sur « Insertion » > « Module » pour ouvrir la fenêtre « Module », puis y copiez l’un des codes VBA suivants.

Code VBA 1 : Enregistrer en lot les pièces jointes de plusieurs e-mails (enregistrer directement les pièces jointes portant exactement le même nom)

Conseil : Ce code enregistre les pièces jointes portant exactement le même nom en y ajoutant les chiffres 1, 2, 3, etc., après le nom du fichier.

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

Code VBA 2 : Enregistrer en lot les pièces jointes de plusieurs e-mails (vérifier les doublons)

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

Remarques :

1) Si vous souhaitez enregistrer toutes les pièces jointes portant le même nom dans un dossier, utilisez le « code VBA 1 » ci-dessus. Avant d’exécuter ce code, cliquez sur « Outils » > « Références », puis cochez la case « Microsoft Scripting Runtime » dans la boîte de dialogue « Références - Projet ».

2) Si vous souhaitez vérifier les doublons Nom de la pièce jointe, utilisez le « code VBA 2 ». Après exécution du code, une boîte de dialogue s’ouvrira pour vous demander si vous souhaitez remplacer Pièces jointes en double ; choisissez « Oui » ou « Non » selon vos besoins.

5. Appuyez sur la touche « F5 » pour exécuter le code.

Toutes les pièces jointes des e-mails sélectionnés sont alors enregistrées dans le dossier créé à l’étape 1.

Remarque : Une boîte de dialogue « Microsoft Outlook » peut apparaître ; cliquez sur le bouton « Autoriser » pour poursuivre.

Enregistrer toutes les pièces jointes de plusieurs e-mails dans un dossier avec un outil exceptionnel

Si vous débutez en VBA, nous vous recommandons vivement l’utilitaire « Enregistrer toutes les pièces jointes » de Kutools pour Outlook. En quelques clics seulement, cet outil vous permet d’enregistrer simultanément toutes les pièces jointes de plusieurs e-mails directement depuis Outlook.

1. Sélectionnez les e-mails contenant les pièces jointes que vous souhaitez enregistrer.

Conseil : vous pouvez sélectionner plusieurs e-mails non adjacents en maintenant la touche « Ctrl » enfoncée et en les choisissant un par un ;
ou sélectionner plusieurs e-mails adjacents en maintenant la touche « Maj » enfoncée et en cliquant sur le premier et le dernier e-mail.

2. Cliquez sur « Kutools Plus » > « Outils de pièces jointes » > « Enregistrer tout ». Voir la capture d’écran :

3. Dans la boîte de dialogue « Paramètres d'enregistrement », cliquez sur le bouton pour sélectionner un dossier dans lequel enregistrer les pièces jointes, puis cliquez sur « OK ».

4. Cliquez deux fois sur « OK » dans les boîtes de dialogue suivantes pour enregistrer simultanément toutes les pièces jointes des e-mails sélectionnés dans le dossier spécifié.

Remarques :

• 1. Pour enregistrer les pièces jointes dans des dossiers distincts selon les e-mails, cochez la case « Créer des sous-dossiers selon le style suivant » et sélectionnez un style de dossier dans la liste déroulante.
• 2. En plus d’enregistrer toutes les pièces jointes, vous pouvez les enregistrer selon des critères précis. Par exemple, si vous souhaitez uniquement conserver les fichiers PDF dont le nom contient le mot « Facture », cliquez sur le bouton « Options avancées » pour afficher les conditions, puis configurez-les comme indiqué ci-dessous.
  
• 3. Si vous souhaitez enregistrer automatiquement les pièces jointes dès réception des e-mails, la fonctionnalité Enregistrer automatiquement les pièces jointes est faite pour vous.
• 4. Pour détacher directement les pièces jointes à partir d’e-mails sélectionnés, la fonctionnalité Détacher toutes les pièces jointes de « Kutools pour Outlook » vous sera d’une grande aide.

Articles associés

---

Meilleurs outils de productivité Office

Découvrez la toute nouvelle Kutools pour Outlook avec 100+ fonctionnalités incroyables !Cliquez pour télécharger dès maintenant !

🤖Kutools IA:Utilise une technologie d’intelligence artificielle avancée pour gérer vos e-mails sans effort, notamment en répondant, résumant, optimisant, développant, traduisant et rédigeant des messages.

📧Automatisation des e-mails : Réponse automatique (disponible pour POP et IMAP) / Planification de l’envoi d’e-mails / CC/BCC automatique selon des règles lors de l’envoi d’e-mails / Transfert automatique (règle avancée) / Ajout automatique de formules de politesse / Division automatique des e-mails à plusieurs destinataires en messages individuels...

📨Gestion des e-mails : Rappeler un e-mail / Bloquer les e-mails frauduleux par objet et autres critères / Supprimer les e-mails en double / Recherche avancée / Organiser vos dossiers…

📁Pièces jointes Pro : Enregistrer en lot / Détacher en lot / Compresser en lot / Enregistrement automatique / Détachement automatique / Compression automatique…

🌟Magie de l’interface : 😊 Encore plus d’emojis jolis et stylés / Vous prévient à l’arrivée d’e-mails importants / Réduire Outlook au lieu de le fermer...

👍Merveilles en un clic : Répondre à tous avec pièces jointes / E-mails anti-hameçonnage / 🕘 Afficher le fuseau horaire – Heure actuelle de l’expéditeur…

👩🏼‍🤝‍👩🏻Contacts et calendrier : Créer en lot : ajouter un contact à partir des e-mails sélectionnés / Diviser un groupe de contacts en groupes individuels / Supprimer le rappel d’anniversaire…

Utilisez Kutools dans votre langue préférée – compatible avec l’anglais, l’espagnol, l’allemand, le français, le chinois et plus de 40 autres langues !

Débloquez Kutools pour Outlook instantanément en un seul clic ! Ne perdez plus une seconde : téléchargez dès maintenant et boostez votre efficacité !

Liste des fonctionnalités de Kutools pour Outlook      Télécharger maintenant      Accéder à l’achat

🚀 Téléchargement en un clic — Obtenez tous les compléments Office

Fortement recommandé : Kutools for Office (5-en-1)

Un seul clic pour télécharger cinq programmes d’installationen une fois —Kutools pour Excel, Outlook, Word, PowerPointet Office Tab Pro.Cliquez pour télécharger dès maintenant !

• ✅Commodité en un clic : téléchargez les cinq packs d’installation en une seule action.
• 🚀Prêt à relever toutes vos tâches Office : installez les compléments dont vous avez besoin, exactement quand vous en avez besoin.
• 🧰Inclus: Kutools pour Excel / Kutools pour Outlook / Kutools pour Word / Office Tab Pro / Kutools for PowerPoint

À propos de la Suite⬇ Télécharger la Suite💳 Acheter la Suite