Discussion :

[Paul Guille]

Bonjour à tous,

Première fois que je poste dans la catégorie VBA de Outlook .

Grace au site,j'ai pu écrire le code suivant pour créer des règles sur base de l'expéditeur de l'email séléctionné à ranger dans un dossier que l'on sélectionne via un User form et liste déroulante.

Aucun soucis tant que je travaillais sur ma boîte perso hors le but est de l'utiliser sur une boîte partagée. Je ne parviens pas à définir le dossier cible pour le transfert.

Merci pour votre aide:

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
 
Public lstNum As Long
Public Sub AssignFolder()
 
    Dim colRules As Outlook.Rules
    Dim oRule As Outlook.Rule
    Dim colRuleActions As Outlook.RuleActions
    Dim oMoveRuleAction As Outlook.MoveOrCopyRuleAction
    Dim oFromCondition As Outlook.ToOrFromRuleCondition
    Dim oExceptSubject As Outlook.TextRuleCondition
    Dim oInbox As Outlook.Folder
    Dim oMoveTarget As Outlook.Folder
    Dim oFoldername As String
    Dim email As Outlook.MailItem
    Dim sender As String
    Dim olSpace As Outlook.NameSpace
    Dim olApp As Object
 
    'Require that this procedure be called only when a message is selected
    If Application.ActiveExplorer.Selection.Count = 0 Then
    MsgBox ("No email selected")
       Exit Sub
    End If
 
    'Specify target folder for rule move action
 
    UserForm1.Show
 
   Select Case lstNum
   Case 0
        oFoldername = "Patricia"
 
   Case 1
        oFoldername = "Paul"
 
   Case 2
        oFoldername = "Stephan"
 
   Case 3
        oFoldername = "Sabine"
 
   Case 4
        oFoldername = "Chantal"
 
   Case 5
        oFoldername = "V?ronique"
 
   End Select
 
 
 
   For Each objItem In Application.ActiveExplorer.Selection
'    If objFolder.DefaultItemType = olMailItem Then
        If objItem.Class = olMail Then
 
            sender = objItem.SenderName
 '       End If
    End If
Next
 
 
    Set olApp = New Outlook.Application
    Set olSpace = olApp.GetNamespace("MAPI")
    Set oInbox = olSpace.Folders("Customer Support").Store.GetDefaultFolder(olFolderInbox)
    'Set oInbox = olSpace.Folders("customer.support.francebenelux@clariant.com").Store.GetDefaultFolder(olFolderInbox)
    'Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
    Set oMoveTarget = oInbox.Folders(oFoldername)
 
    'Get Rules from Session.DefaultStore object
    Set colRules = Application.Session.DefaultStore.GetRules()
 
    'Create the rule by adding a Receive Rule to Rules collection
    Set oRule = colRules.Create(sender, olRuleReceive)
 
    'Specify the condition in a ToOrFromRuleCondition object
    'Condition is if the message is from "Dan Wilson"
    Set oFromCondition = oRule.Conditions.From
    With oFromCondition
        .Enabled = True
        .Recipients.Add (sender)
        .Recipients.ResolveAll
    End With
 
    'Specify the action in a MoveOrCopyRuleAction object
    'Action is to move the message to the target folder
    Set oMoveRuleAction = oRule.Actions.MoveToFolder
    With oMoveRuleAction
        .Enabled = True
        .Folder = oMoveTarget
    End With
 
    'Specify the exception condition for the subject in a TextRuleCondition object
    'Exception condition is if the subject contains "fun" or "chat"
    'Set oExceptSubject = _
    '    oRule.Exceptions.Subject
    'With oExceptSubject
    '    .Enabled = True
    '    .Text = Array("fun", "chat")
    'End With
 
    'Update the server and display progress dialog
 
    colRules.Save
    oRule.Execute ShowProgress:=True, Folder:=Session.GetDefaultFolder(olFolderInbox), IncludeSubfolders:=False, RuleExecuteOption:=2
 
End Sub

[Oliv-]

Il faut bien cibler la BAL partagée.

Peut être qu'il faudra ajouter en tant que compte dans outlook cette boite.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub testrules()
Set Mystores = Application.Session.Stores("bal@societe.com")
  Set colRules = Mystores.GetRules()
  Set Inbox = Mystores.GetDefaultFolder(olFolderInbox)
 
End Sub

[Paul Guille]

Tout simplement parfait.

Cela tourne nickel.

Merci