Comment enregistrer toutes les pièces jointes de plusieurs emails dans un dossier sous Outlook ?

Il est facile d'enregistrer toutes les pièces jointes d'un email avec la fonctionnalité Enregistrer toutes les pièces jointes intégrée dans Outlook. Cependant, si vous souhaitez enregistrer toutes les pièces jointes de plusieurs emails à la fois, il n'y a pas de fonction directe pour vous aider. Vous devez répéter l'utilisation de la fonction Enregistrer toutes les pièces jointes pour chaque email jusqu'à ce que toutes les pièces jointes soient sauvegardées. C'est chronophage. Dans cet article, nous vous présentons deux méthodes pour enregistrer en masse toutes les pièces jointes de plusieurs emails dans un dossier spécifique sous Outlook.

Enregistrer toutes les pièces jointes de plusieurs emails dans un dossier avec du code VBA
Quelques clics pour enregistrer toutes les pièces jointes de plusieurs emails dans un dossier avec un outil incroyable

Enregistrer toutes les pièces jointes de plusieurs emails dans un dossier avec du code VBA

Cette section présente un code VBA étape par étape pour vous aider à enregistrer rapidement toutes les pièces jointes de plusieurs emails dans un dossier spécifique en une seule fois. Veuillez suivre les étapes ci-dessous.

1. Tout d'abord, vous devez créer un dossier pour enregistrer les pièces jointes sur votre ordinateur.

Accédez au dossier "Documents" et créez un dossier nommé "Pièces jointes". Voir capture d'écran :

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

3. Cliquez sur "Insérer" > "Module" pour ouvrir la fenêtre "Module", puis copiez l'un des codes VBA suivants dans cette fenêtre.

Code VBA 1 : Enregistrement en masse des pièces jointes de plusieurs emails (enregistrement direct des pièces jointes ayant exactement le même nom)

Remarque : Ce code enregistrera les pièces jointes ayant exactement le même nom en ajoutant les chiffres 1, 2, 3... après les noms de fichiers.

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 : Enregistrement en masse des pièces jointes de plusieurs emails (vérification des 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

Notes :

1) Si vous souhaitez enregistrer toutes les pièces jointes ayant le même nom dans un dossier, veuillez appliquer 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 noms de pièces jointes en double, veuillez appliquer le "Code VBA 2". Après avoir exécuté le code, une boîte de dialogue apparaîtra pour vous rappeler s'il faut remplacer les 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 emails sélectionnés sont ensuite enregistrées dans le dossier que vous avez créé à l'étape 1.

Notes : Une boîte de dialogue "Microsoft Outlook" peut apparaître, veuillez cliquer sur le bouton "Autoriser" pour continuer.

Enregistrer toutes les pièces jointes de plusieurs emails dans un dossier avec un outil incroyable

Si vous êtes débutant en VBA, voici une recommandation forte : l'utilitaire "Enregistrer toutes les pièces jointes" de "Kutools pour Outlook". Avec cet utilitaire, vous pouvez rapidement enregistrer toutes les pièces jointes de plusieurs emails en quelques clics seulement sous Outlook.

1. Sélectionnez les emails contenant les pièces jointes que vous souhaitez enregistrer.

Astuce : Vous pouvez sélectionner plusieurs emails non adjacents en maintenant la touche "Ctrl" et en les sélectionnant un par un ;
Ou sélectionnez plusieurs emails adjacents en maintenant la touche "Shift" et en sélectionnant le premier et le dernier email.

2. Cliquez sur "Kutools Plus" > "Outils de pièces jointes" > "Enregistrer tout". Voir capture d'écran :

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

4. Cliquez sur "OK" deux fois dans les prochaines boîtes de dialogue qui apparaissent. Toutes les pièces jointes des emails sélectionnés sont alors enregistrées dans le dossier spécifié en une seule fois.

Notes :

• 1. Si vous souhaitez enregistrer les pièces jointes dans différents dossiers en fonction des emails, cochez la case "Créer des sous-dossiers dans le style suivant" et choisissez un style de dossier dans le menu déroulant.
• 2. Outre l'enregistrement de toutes les pièces jointes, vous pouvez enregistrer des pièces jointes selon des conditions spécifiques. Par exemple, si vous souhaitez uniquement enregistrer les pièces jointes de fichiers PDF dont le nom de fichier contient le mot "Facture", cliquez sur le bouton "Options avancées" pour développer les conditions, puis configurez comme indiqué ci-dessous.
  
• 3. Si vous souhaitez enregistrer automatiquement les pièces jointes lorsque les emails arrivent, la fonctionnalité Enregistrer automatiquement les pièces jointes peut vous aider.
• 4. Pour détacher directement les pièces jointes des emails sélectionnés, la fonctionnalité Détacher toutes les pièces jointes de "Kutools pour Outlook" peut vous être utile.

Articles connexes

---

Meilleurs outils de productivité pour Office

Dernière nouvelle : Kutools pour Outlook lance sa version gratuite !

Découvrez le tout nouveau Kutools pour Outlook avec plus de100 fonctionnalités incroyables ! Cliquez pour télécharger dès maintenant !

🤖 Kutools IA : Exploite une technologie avancée d’IA pour gérer les e-mails en toute simplicité, notamment pour répondre, résumer, optimiser, étendre, traduire et rédiger des e-mails.

📧 Automatisation des E-mails : Réponse automatique (disponible pour POP et IMAP) / Programmer l’envoi d’un e-mail / CC/BCC automatique par règle lors de l’envoi / Transfert automatique (règle avancée) / Ajouter automatiquement une salutation / Diviser automatiquement les e-mails multi-destinataires en messages individuels ...

📨 Gestion des E-mails : Rappeler lemail / Bloquer les e-mails frauduleux par objet et autres critères / Supprimer les doublons / Recherche Avancée / Organiser les dossiers ...

📁 Pièces jointes Pro : Enregistrement en lot / Détachement en lot / Compression en lot / Enregistrer automatiquement / Détachement automatique / Compression automatique ...

🌟 Interface magique : 😊Plus d’emojis élégants et amusants / Vous rappelle lorsque des e-mails importants arrivent / Réduire Outlook au lieu de fermer ...

👍 Fonctions en un clic : Répondre à tous avec pièces jointes / E-mails anti-phishing / 🕘Afficher le fuseau horaire de l’expéditeur ...

👩🏼‍🤝‍👩🏻 Contacts & Calendrier : Ajouter en lot des contacts à 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 – prend en charge l’Anglais, l’Espagnol, l’Allemand, le Français, le Chinois et plus de40 autres !

Débloquez instantanément Kutools pour Outlook en un seul clic. N’attendez pas, téléchargez dès maintenant pour gagner en efficacité !

Tableau unidimensionnel des fonctionnalités de Kutools pour Outlook Télécharger maintenant Aller à Acheter

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

Recommandé vivement : Kutools pour Office (5-en-1)

Un clic pour télécharger cinq installateurs en une seule fois — Kutools pour Excel, Outlook, Word, PowerPoint et Office Tab Pro. Cliquez pour télécharger dès maintenant !

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

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