Bonjour,
Cette fois-ci un code qui m'est bien utile qui me permet :
- Créer un nouveau dossier sur n'importe quelle BAL
- Déplacer 1 ou un ensemble de mails dedans
Enjoy,
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34 ' Déplacement des Mails Dim MonApply As Outlook.Application Dim MaTache As Outlook.TaskItem Dim MonMail As Outlook.MailItem Dim MonNSpace As Outlook.namespace Dim FldDossier As Outlook.Folder Dim monRepDest As Outlook.MAPIFolder Dim strObjet As String Dim strTitre As String Dim MaSelection As Outlook.Selection Set MonApply = Outlook.Application Set MonNSpace = MonApply.GetNamespace("MAPI") Set FldDossier = MonNSpace.GetDefaultFolder(olFolderInbox) ' Récupère tous les mails sélectionnés Set MaSelection = MonApply.ActiveExplorer.Selection nbmail = MaSelection.Count ' Demande dans quel répertoire sauvegarder les mails et archive les mails Set monRepDest = MonNSpace.PickFolder If TypeName(monRedDest) <> "Nothing" Then For Each MonMail In MaSelection MonMail.Move monRepDest Next MonMail End If 'Vide des instances Set MonApply = Nothing Set MonNSpace = Nothing Set FldDossier = Nothing Set MonMail = Nothing Set MaTache = Nothing
Pet's
Partager