Macro Outlook pour la suppression des pièces jointes

Je suis un gros utilisateur d’Outlook au travail. Autant il est possible de détacher en une fois l’ensemble des pièces jointes reçues avec un e-mail autant je n’ai jamais compris pourquoi il est n’y avait pas une fonctionnalité permettant de supprimer l’ensemble de ces même pièces jointes.

Voici une macro qui permet de remédier à ce manque. Il vous suffira ensuite de l’associer à un boutons dans votre barre d’outil et éventuellement d’y associer un raccourci clavier.

Sub supprimerAttachement()
‘Amadou
‘Macro destinée à supprimer les pieces jointes d’un e-mail

Dim OlApp As Outlook.Application
Dim objItem As Outlook.MailItem
Dim compteur As Integer
Dim nomFichier As String

Set OlApp = New Outlook.Application

On Error Resume Next

For Each objItem In Application.ActiveExplorer.Selection
compteur = objItem.Attachments.Count

If compteur > 0 Then
‘introduction d’une ligne de séparation dans le corps du mail
objItem.Body = “————– ” & vbCr & objItem.Body
End If

Do While compteur > 0
‘place le nom du fichier qui va être supprimé dans le corps du mail
nomFichier = objItem.Attachments.Item(1).FileName
objItem.Body = “>> Attachement: ” & nomFichier & vbCrLf & objItem.Body
objItem.Attachments.Remove (1) ’suppression de la piece jointe
objItem.Save    ‘enregistrer le message pour remettre à jour la collection d’attachement
compteur = compteur – 1
Loop

Next

Set objItem = Nothing
End Sub