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

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
Enjoy,

Pet's