Passer au contenu principal

Comment répondre à tous avec les pièces jointes d'origine dans Outlook?

Normalement, lorsque vous appliquez la fonction Répondre à tous pour répondre au message à tous les destinataires dans Outlook, les pièces jointes d'origine seront automatiquement perdues. Est-il possible de joindre des pièces jointes d'origine lors de la réponse à tous dans Outlook?

Répondez à tous avec les pièces jointes d'origine avec le code VBA

Répondez à tous avec les pièces jointes originales avec Kutools for Outlook


Répondez à tous avec les pièces jointes d'origine avec le code VBA

Il n'y a pas de fonctionnalité directe pour gérer cette tâche dans Outlook, mais vous pouvez appliquer le code VBA suivant pour y parvenir. Veuillez suivre les étapes ci-dessous:

1. Lancez Outlook, puis maintenez la touche ALT + F11 clés pour ouvrir le Microsoft Visual Basic pour applications fenêtre.

2. Dans le Microsoft Visual Basic pour applications fenêtre, double-cliquez Cette session Outlook du Projet1 (VbaProject.OTM) volet pour ouvrir le mode, puis copiez et collez le code suivant dans le module vide.

Code VBA: Répondez à tous avec les ahhachments originaux:

Sub ReplyAllWithAttachments()
'Updateby Extendoffice
Dim xItem As Object
On Error Resume Next
Select Case TypeName(Outlook.Application.ActiveWindow)
Case "Explorer"
For Each xItem In Outlook.Application.ActiveExplorer.Selection
GetReplyItem xItem
Next
Case "Inspector"
Set xItem = Outlook.Application.ActiveInspector.CurrentItem
GetReplyItem xItem
End Select
Set xItem = Nothing
End Sub
Sub GetReplyItem(Item As Object)
Dim xReplyMailItem As Outlook.MailItem
On Error Resume Next
If Not Item Is Nothing Then
Set xReplyMailItem = Item.ReplyAll
GetAttachments Item, xReplyMailItem
xReplyMailItem.Display
'xReplyMailItem.Send
Item.UnRead = False
End If
Set xReplyMailItem = Nothing
End Sub
Sub GetAttachments(xSourceItem, xTargetItem)
Dim xFSO As Scripting.FileSystemObject
Dim xTmpPath As String
Dim xAttachment As Attachment
Dim xTmpFile As String
On Error Resume Next
Set xFSO = New Scripting.FileSystemObject
xTmpPath = CreateObject("shell.Application").NameSpace(5).self.Path & "\TmpAttachments\"
If xFSO.FolderExists(xTmpPath) = False Then
MkDir xTmpPath
End If
For Each xAttachment In xSourceItem.Attachments
If IsEmbeddedAttachment(xAttachment) = False Then
xTmpFile = xTmpPath & xAttachment.FileName
xAttachment.SaveAsFile xTmpFile
xTargetItem.Attachments.Add xTmpFile, , , xAttachment.DisplayName
xFSO.DeleteFile xTmpFile
End If
Next
If xFSO.FolderExists(xTmpPath) Then
Kill xTmpPath
End If
Set xFSO = Nothing
End Sub
Function IsEmbeddedAttachment(Attach As Attachment)
Dim xAttParent As Object
Dim xCID As String, xID As String
Dim xHTML As String
On Error Resume Next
Set xAttParent = Attach.Parent
xCID = ""
xCID = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCID <> "" Then
xHTML = xAttParent.HTMLBody
xID = "cid:" & xCID
If InStr(xHTML, xID) > 0 Then
IsEmbeddedAttachment = True
Else
IsEmbeddedAttachment = False
End If
End If
End Function

doc répond à tous avec pièce jointe 1

3. Et puis cliquez Outils > Bibliographie dans l' Microsoft Visual Basic pour applications fenêtre, dans le sauté Références-Projet1 boîte de dialogue, cochez Exécution de scripts Microsoft Option de Références disponibles zone de liste, voir capture d'écran:

doc répond à tous avec pièce jointe 9

4. Ensuite, enregistrez et fermez la fenêtre de code, puis vous pouvez ajouter le bouton macro dans le Barre d'outils d'accès rapide.

5. Ouvrez l'e-mail auquel vous souhaitez répondre avec une pièce jointe dans Message fenêtre, puis choisissez Plus de commandes du Personnaliser la barre d'outils Accès rapide déroulant, voir capture d'écran:

doc répond à tous avec pièce jointe 2

6. Dans le Options d'Outlook boîte de dialogue, effectuez les opérations suivantes:

(1.) Sélectionnez Macros du Choisissez les commandes de la liste déroulante;

(2.) Cliquez sur le nom de la macro que vous venez d'insérer;

(3.) Et puis cliquez sur Ajouter pour ajouter la macro dans le Personnaliser la barre d'outils Accès rapide.

doc répond à tous avec pièce jointe 3

7. Puis clique OK pour fermer la boîte de dialogue, maintenant, le bouton macro a été inséré dans le Barre d'outils d'accès rapide, voir capture d'écran:

doc répond à tous avec pièce jointe 4

8. Maintenant, cliquez sur le bouton macro et la fenêtre du message de réponse avec les pièces jointes d'origine est ouverte, puis rédigez le message de réponse et cliquez sur Envoyer bouton, voir capture d'écran:

doc répond à tous avec pièce jointe 5


Répondez à tous avec les pièces jointes originales avec Kutools for Outlook

Si vous avez Kutools for Outlook, Avec son Répondre à tous avec pièce jointe fonctionnalité, vous pouvez répondre à tous avec des pièces jointes en un seul clic.

Kutools for Outlook : avec plus de 100 compléments Outlook pratiques, essai gratuit sans limitation dans 60 jours. 

Après l'installation de Kutools for Outlook, veuillez faire comme ceci:

1. Sélectionnez le message auquel vous souhaitez répondre avec des pièces jointes, puis cliquez sur Kutools > Répondre avec pièce jointe > Répondre à tous avec pièce jointe, voir capture d'écran:

2. Et la fenêtre du message de réponse est ouverte avec les pièces jointes d'origine, puis composez votre message et envoyez-le, voir capture d'écran:

doc répond à tous avec pièce jointe 7

Cliquez pour télécharger Kutools pour Outlook et essai gratuit maintenant !


Meilleurs outils de productivité bureautique

Kutools for Outlook - Plus de 100 fonctionnalités puissantes pour booster votre Outlook

🤖 Assistant de messagerie IA: E-mails professionnels instantanés avec la magie de l'IA : un clic pour des réponses géniales, un ton parfait, une maîtrise multilingue. Transformez l’emailing sans effort ! ...

📧 Email Automation: Absent du bureau (disponible pour POP et IMAP)  /  Programmer l'envoi d'e-mails  /  Auto CC/BCC par règles lors de l'envoi d'un e-mail  /  Transfert automatique (règles avancées)   /  Ajouter un message d'accueil automatique   /  Divisez automatiquement les e-mails multi-destinataires en messages individuels 

(I.e. Email Management: Rappel facile des e-mails  /  Bloquer les e-mails frauduleux par sujets et autres  /  Supprimer les e-mails en double  /  Recherche Avancée  /  Consolider les dossiers 

(I.e. Pièces jointes ProSauvegarde par lots  /  Détachement par lots  /  Compression par lots  /  Enregistrement automatique   /  Détachement automatique  /  Compression automatique 

???? Magie de l'interface: 😊Plus d'émojis jolis et cool   /  Boostez votre productivité Outlook avec des vues à onglets  /  Réduire Outlook au lieu de fermer 

???? Merveilles en un clic: Répondre à tous avec les pièces jointes entrantes  /   E-mails anti-hameçonnage  /  🕘Afficher le fuseau horaire de l'expéditeur 

👩🏼‍🤝‍👩🏻 Contacts et calendrier: Ajouter par lots des contacts à partir des e-mails sélectionnés  /  Diviser un groupe de contacts en groupes individuels  /  Supprimer les rappels d'anniversaire 

infos Caractéristiques 100 Attendez votre exploration ! Cliquez ici pour en savoir plus.

 

 

Comments (15)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Is it possible that, after a reboot or windows update, the macro is not working anymore? Also after doing again the procedure is not working anymore
This comment was minimized by the moderator on the site
Bonjour, la macro n'a fonctionné qu'une seule fois, dommage
This comment was minimized by the moderator on the site
Bonjour, nickel, mais n'a fonctionné qu'une fois. dommage
This comment was minimized by the moderator on the site
BonjourCette macros est super malheureusement cela ne fonctionne qu'une fois.. dommage
This comment was minimized by the moderator on the site
is there a macro that replies to all keeps attachments and keeps the original email in text format?
This comment was minimized by the moderator on the site
Thank you very much, you are the only one to share this macro and it's awesome, thank you for your work !
This comment was minimized by the moderator on the site
a macro VBA só funciona por um dia?
This comment was minimized by the moderator on the site
Bonjour,


Super, ça marche à merveille. J'ai visité plein de tuto et d'échange sur le sujet et aucune réponse satisfaisante avant celui-ci. Sachant que jusqu'à présent, je bricolais toujours entre "transférer" et remettre les destinataires ou "répondre à tous" et remettre la ou les pièces jointes. Encore merci.

Harivola
This comment was minimized by the moderator on the site
All files in mail adding as attachment such as image in my signiture.
How can i only attachment files
This comment was minimized by the moderator on the site
Hi,
If you need to exclude the images within the messages which are inserted into the attachments, please apply the below VBA code, hope it can help you!
Sub ReplyAllWithAttachments()
Dim xItem As Object
On Error Resume Next
Select Case TypeName(Outlook.Application.ActiveWindow)
Case "Explorer"
For Each xItem In Outlook.Application.ActiveExplorer.Selection
GetReplyItem xItem
Next
Case "Inspector"
Set xItem = Outlook.Application.ActiveInspector.CurrentItem
GetReplyItem xItem
End Select
Set xItem = Nothing
End Sub
Sub GetReplyItem(Item As Object)
Dim xReplyMailItem As Outlook.MailItem
On Error Resume Next
If Not Item Is Nothing Then
Set xReplyMailItem = Item.ReplyAll
GetAttachments Item, xReplyMailItem
xReplyMailItem.Display
'xReplyMailItem.Send
Item.UnRead = False
End If
Set xReplyMailItem = Nothing
End Sub
Sub GetAttachments(xSourceItem, xTargetItem)
Dim xFSO As Scripting.FileSystemObject
Dim xTmpPath As String
Dim xAttachment As Attachment
Dim xTmpFile As String
On Error Resume Next
Set xFSO = New Scripting.FileSystemObject
xTmpPath = CreateObject("shell.Application").NameSpace(5).self.Path & "\TmpAttachments\"
If xFSO.FolderExists(xTmpPath) = False Then
MkDir xTmpPath
End If
For Each xAttachment In xSourceItem.Attachments
If IsEmbeddedAttachment(xAttachment) = False Then
xTmpFile = xTmpPath & xAttachment.FileName
xAttachment.SaveAsFile xTmpFile
xTargetItem.Attachments.Add xTmpFile, , , xAttachment.DisplayName
xFSO.DeleteFile xTmpFile
End If
Next
If xFSO.FolderExists(xTmpPath) Then
Kill xTmpPath
End If
Set xFSO = Nothing
End Sub
Function IsEmbeddedAttachment(Attach As Attachment)
Dim xAttParent As Object
Dim xCID As String, xID As String
Dim xHTML As String
On Error Resume Next
Set xAttParent = Attach.Parent
xCID = ""
xCID = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCID <> "" Then
xHTML = xAttParent.HTMLBody
xID = "cid:" & xCID
If InStr(xHTML, xID) > 0 Then
IsEmbeddedAttachment = True
Else
IsEmbeddedAttachment = False
End If
End If
End Function
This comment was minimized by the moderator on the site
I signed up just to say thank you! Skyyang.
This comment was minimized by the moderator on the site
Thanks alot
This comment was minimized by the moderator on the site
Getting compile error as : User-define type not defined at line no " Dim xFSO As Scripting.FileSystemObject" under "Sub GetAttachments(xSourceItem, xTargetItem)"
Kindly Advice on this error.
This comment was minimized by the moderator on the site
Hello, Sam,
Sorry, the article misses the step 3, I have updated this article, please try again. Hope it can help you!

Thank you for your reminder.
This comment was minimized by the moderator on the site
Thank you so much skyyang!!

Works like a charm.

Best Regards
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations