[Outlook][VBA] Déplace les mails d'un dossier
Bonjour,
J'utilise outlook.com (anciennement hotmail) pour hébergé mes mails, et j'utilise outlook pour les lires (je précise car la confusion peut rapidement arrivé).
Actuellement, je ne reçois aucun spam sur ma boite mail, mais le probleme c'est que outlook.com me met régulièrement des mails très importants dans le dossier Junk (Spams).Je le vois pas toujours ce qui est très grave vu que c'est ma boite pro et c'est d'autant plus énervant qu'il est impossible de désactiver cette fonction anti-spam.
Par conséquent, je cherche un script VBA qui déplace automatiquement les mails du dossier "Junk" dans la boite de reception.
Pourriez vous m'aider ?
Merci d'avance
Bonsoir,
Voici un exemple de code que j'utilise mais que tu dois adapter. Je ne suis pas un spécialiste du VBA sous Outlook, il est donc possible qu'il puisse être optimisé.
Code à mettre dans un module standard :
Option Explicit
Sub TraitementMessages()
Dim FldJunk As Outlook.MAPIFolder, FldBdR As Outlook.MAPIFolder
Dim Fld As Folder, Message As Outlook.MailItem, lCpt As Long ', Pj As Outlook.Attachment
' Recherche de la boite aux lettres et définition de ses dossiers
For Each Fld In Outlook.Session.Folders
If Fld.Name Like "*NomDeTaBoiteAuxLettres*" Then
Set FldJunk = Fld.Folders("Junk")
Set FldBdR = Fld.Folders("Boîte de réception")
Exit For
End If
Next Fld
' Boucle des messages
For lCpt = FldJunk .Items.Count To 1 Step -1
If TypeName(FldJunk .Items(lCpt)) = "MailItem" Then
Set Message = FldJunk .Items(lCpt)
If (Message.Subject Like "Mouvements Supports*") Then
Message.UnRead = False: Message.Move FldBdR
End If
End If
Next lCpt
Fin:
Set Message = Nothing
Set Fld = Nothing
Set FldBR = Nothing
Set FldSDM = Nothing
End Sub
Ce code à adapter sur ton ordi, car je l'ai fait pour mon boulot, la première partie du code est de rechercher une boite aux lettres précise. Si tu n'as qu'une boite aux lettres, et sans dossiers personnels, tu peux certainement simplifier cette partie.
Pour que l'exécution de code soit interactif, il faut utiliser l'événement NewMail pour lancer la macro à la réception des messsages.