Règles Outlook VBA

**Fulv95** · 07/07/2017, 10h24

,

J'ai besoin de faire une macro pour créer des règles Outlook.

J'ai utilisé l'exemple du site https://msdn.microsoft.com/VBA/Outlo...method-outlook en l'adaptant à mes besoins.

Le déplacement vers un dossier et les exceptions du sujet fonctionnent, mais pas les conditions du sujet et l’ajout dans une catégorie.

Code testé :

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
 
 
Sub CreateOutlookRule()
 
    Dim colRules As Outlook.Rules:salut:
    Dim oRule As Outlook.Rule
    Dim colRuleActions As Outlook.RuleActions
 
    Dim oMoveRuleAction As Outlook.MoveOrCopyRuleAction
    Dim oSubjectCondition As Outlook.TextRuleCondition
    Dim oExceptSubject As Outlook.TextRuleCondition
    Dim oCategory As Outlook.AssignToCategoryRuleAction
 
    Dim oInbox As Outlook.folder
    Dim oMoveTarget As Outlook.folder
 
    Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
    Set oMoveTarget = oInbox.Folders("test")
    Set colRules = Application.Session.DefaultStore.GetRules()
    Set oRule = colRules.Create("TEST", olRuleReceive)
 
    'Deplacer le message vers un dossier
    Set oMoveRuleAction = oRule.Actions.MoveToFolder
    With oMoveRuleAction
        .Enabled = True
        .folder = oMoveTarget
    End With
 
    'Ajouter le message à une catégorie
    Set oCategory = oRule.Action.AssignToCategory
    With oCategory
        .Enabled = True
        .Categories = Array("test")
    End With
 
    'Mots que le sujet doit contenir
    Set oSubjectCondition = oRule.Condition.Subject
    With oSubjectCondition
        .Enabled = True
        .Text = Array("test")
    End With
 
    'Mots que le sujet ne doit pas contenir
    Set oExceptSubject = oRule.Exceptions.Subject
    With oExceptSubject
        .Enabled = True
        .Text = Array("RE:", "FW:")
    End With
 
    colRules.Save
End Sub

Pourriez-vous me donner un coup de main svp ?

Merci pour votre aide.

**Oliv-** · 07/07/2017, 10h35

Bonjour,
As tu un message d'erreur ?

essaye comme cela

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
 
 
Sub CreateOutlookRule()
 
    Dim colRules As Outlook.Rules:salut:
    Dim oRule As Outlook.Rule
    Dim colRuleActions As Outlook.RuleActions
 
    Dim oMoveRuleAction As Outlook.MoveOrCopyRuleAction
    Dim oSubjectCondition As Outlook.TextRuleCondition
    Dim oExceptSubject As Outlook.TextRuleCondition
    Dim oCategory As Outlook.AssignToCategoryRuleAction
 
    Dim oInbox As Outlook.folder
    Dim oMoveTarget As Outlook.folder
 
    Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox)
    Set oMoveTarget = oInbox.Folders("test")
    Set colRules = Application.Session.DefaultStore.GetRules()
    Set oRule = colRules.Create("TEST", olRuleReceive)
 
    'Deplacer le message vers un dossier
    Set oMoveRuleAction = oRule.Actions.MoveToFolder
    With oMoveRuleAction
        .Enabled = True
        .folder = oMoveTarget
    End With
 
    'Ajouter le message à une catégorie
    Set oCategory = oRule.Actions.AssignToCategory
    With oCategory
        .Enabled = True
        .Categories = Array("test")
    End With
 
    'Mots que le sujet doit contenir
    Set oSubjectCondition = oRule.Conditions.Subject
    With oSubjectCondition
        .Enabled = True
        .Text = Array("test")
    End With
 
    'Mots que le sujet ne doit pas contenir
    Set oExceptSubject = oRule.Exceptions.Subject
    With oExceptSubject
        .Enabled = True
        .Text = Array("RE:", "FW:")
    End With
 
    colRules.Save
End Sub

**Fulv95** · 07/07/2017, 10h45

Effectivement ça fonctionne.

pour ton aide.

**Fulv95** · 07/07/2017, 15h00

J'ai mis ma macro dans un fichier Excel et lorsque je l'exécute j'ai l'erreur "Run-time error '438' : Object doesn't support property or method" sur la ligne Set oInbox = Application.Session.GetDefaultFolder(olFolderInbox).

**Oliv-** · 07/07/2017, 17h01

parce que excel n'est pas outlook !
il faut ajouter une référence à "Microsoft Outlook xx.x Object Library" dans outils /références de VBE

Code :

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

1
2
3
4
5
6
7
Dim OL As Outlook.Application
 
    If UCase(Application) = "OUTLOOK" Then
        Set OL = Application
    Else
        Set OL = CreateObject("outlook.application")
    End If

et tu remplaces "Application." par "OL." (dans le précédent code uniquement)

**Fulv95** · 10/07/2017, 10h26

Pour ajouter la référence automatiquement depuis vba j'ai essayé le code du site https://www.developpez.net/forums/d2...n-d-reference/ en l'adaptant.

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
 
Sub add1()
    Dim NomComplet As String
    NomComplet = "C:\Program Files(x86)\Microsoft Office\Root\Office16\MSOU"
    ThisWorkbook.VBProject.References.AddFromFile NomComplet
End Sub
 
Sub add2()
    If Not ReferenceActive("Microsoft Outlook 16.0 Object Library") Then
        ActiverReference "C:\Program Files(x86)\Microsoft Office\Root\Office16\MSOU"
    End If
End Sub
 
Function ReferenceActive(Nom As String) As Boolean
    Dim i As Integer
    Dim NbreRef As Integer
 
    NbreRef = ThisWorkbook.VBProject.References.Count
 
    For i = 1 To NbreRef
        If ThisWorkbook.VBProject.References(i).Name = Nom Then
            ReferenceActive = True
            Exit Function
        End If
    Next i
End Function

Avec la méthode add1() j'obtiens l'erreur : "Sub or Fonction not define"

Avec la méthode add2() : "Method VBproject' of object' _Workbook' failed"

**Oliv-** · 10/07/2017, 12h30

Bonjour,
Pourquoi veux tu ajouter la référence automatiquement ? tu as plusieurs versions de Office qui vont utiliser ta macro ?

**Fulv95** · 10/07/2017, 13h29

Bonjour,

Je veux ajouter la référence automatiquement pour eviter aux utilisateurs de le faire.

**Oliv-** · 10/07/2017, 13h59

Une fois que tu as ajouté la référence elle reste dans ton fichier Excel ! Tu n'as besoin de changer cette réfécence que si les utilisateurs ont des versions différentes de OFFICE.

Sinon tu peux utiliser le LATE BINDING

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
 
 
Sub CreateOutlookRule()
Dim OL As Outlook.Application
 
    If UCase(Application) = "OUTLOOK" Then
        Set OL = Application
    Else
        Set OL = CreateObject("outlook.application")
    End If
 
const olFolderInbox= 6
Const olRuleReceive=0
 
    Dim colRules As Object   'Outlook.Rules
    Dim oRule As Object   'As Outlook.Rule
    Dim colRuleActions As Object   'As Outlook.RuleActions
 
    Dim oMoveRuleAction As Object   'As Outlook.MoveOrCopyRuleAction
    Dim oSubjectCondition As Object   'As Outlook.TextRuleCondition
    Dim oExceptSubject As Object   'As Outlook.TextRuleCondition
    Dim oCategory As Object   'As Outlook.AssignToCategoryRuleAction
 
    Dim oInbox As Object   'As Outlook.folder
    Dim oMoveTarget As Object   'As Outlook.folder
 
    Set oInbox = OL.Session.GetDefaultFolder(olFolderInbox)
    Set oMoveTarget = oInbox.Folders("test")
    Set colRules = OL.Session.DefaultStore.GetRules()
    Set oRule = colRules.Create("TEST", olRuleReceive)
 
    'Deplacer le message vers un dossier
    Set oMoveRuleAction = oRule.Actions.MoveToFolder
    With oMoveRuleAction
        .Enabled = True
        .folder = oMoveTarget
    End With
 
    'Ajouter le message à une catégorie
    Set oCategory = oRule.Actions.AssignToCategory
    With oCategory
        .Enabled = True
        .Categories = Array("test")
    End With
 
    'Mots que le sujet doit contenir
    Set oSubjectCondition = oRule.Conditions.Subject
    With oSubjectCondition
        .Enabled = True
        .Text = Array("test")
    End With
 
    'Mots que le sujet ne doit pas contenir
    Set oExceptSubject = oRule.Exceptions.Subject
    With oExceptSubject
        .Enabled = True
        .Text = Array("RE:", "FW:")
    End With
 
    colRules.Save
End Sub

**Fulv95** · 10/07/2017, 14h38

Ok,

beaucoup pour ton aide

Règles Outlook VBA [OL-2016]

VBA Outlook

Discussions similaires

Partager

Partager