Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre à l'essai
    Création automatique de règles sur une boite partagée
    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

  2. #2
    Expert éminent
    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

  3. #3
    Membre à l'essai
    Tout simplement parfait.

    Cela tourne nickel.

    Merci

###raw>template_hook.ano_emploi###