Macro en VBA pour effacer les fichiers joints d'un ou plusieurs messages...
Après sélection de un ou plusieurs messages on efface tous les fichiers joints d'un seul clic.
Source / Exemple :
Sub EffacerLesFichiersJoints()
Dim OutlookApp As New Outlook.Application
Dim OutlookExp As Outlook.Explorer
Dim OutlookSélex As Outlook.Selection
Dim x As Integer
Dim i As Integer
'Procedure de traitement des messages
Set myOlApp = CreateObject("Outlook.Application")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookExp = OutlookApp.ActiveExplorer
Set OutlookSélex = OutlookExp.Selection
If OutlookSélex.Count < 1 Then
MsgBox "Aucun message n'est sélectionné.", vbExclamation, "Erreur"
Exit Sub
End If
For x = 1 To OutlookSélex.Count
Set myItem = OutlookSélex.Item(x)
If myItem.Attachments.Count > 0 Then
NbFic = myItem.Attachments.Count
For pi = 1 To myItem.Attachments.Count
Set myattachments = myItem.Attachments
'Efface la piece attachee
myattachments.Remove 1
'myattachments.Item(pi).Delete
Set myattachments = Nothing
Next
Else
MsgBox "Le message ne contient pas de fichier joint.", vbExclamation, "Erreur"
End If
Next x
Set myattachments = Nothing
Set myItem = Nothing
End Sub
Conclusion :
me donner votre avis et les améliorations à y apporter !!
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.