1
votes

Modifier l'état du drapeau lors du passage à la boîte aux lettres partagée

Est-il possible de changer le statut des e-mails déplacés vers un dossier dans une boîte aux lettres partagée?

Exemple: je reçois un nouveau e-mail et le marque avec un drapeau rouge. Ensuite, lorsque le travail est terminé, je déplace le courrier dans le dossier "Terminé".

Après avoir déplacé le courrier dans ce dossier, je veux que le Flagstatus soit "olFlagComplete" (drapeau vert) et à chaque fois J'ouvre Outlook, le code doit vérifier le dossier pour les e-mails avec un drapeau rouge (par exemple, Mails déplacés depuis un téléphone portable) et le définir sur un drapeau vert.

J'ai essayé ce qui suit, mais rien ne s'est passé.

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Dim olNameSpace As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder

    Set olNameSpace = Application.GetNamespace("MAPI")
    Set olFolder = olNameSpace.Folders("name@company.com")
    Set olFolder = olFolder.Folders("Completed")
    Set Items = olFolder.Items
End Sub

Private Sub Items_ItemChange(ByVal Item As Object)
    Dim olNameSpace As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
    Dim Mail As MailItem

    Set olNameSpace = Application.GetNamespace("MAPI")
    Set olFolder = olNameSpace.Folders("name@company.com")
    Set olFolder = olFolder.Folders("Completed")

    If TypeOf Item Is Outlook.MailItem Then
        Set Mail = Item

        If Mail.FlagStatus = olFlagMarked Then
            'Set ItemCopy = Item.Copy ' Copy Flagged item
            'ItemCopy.Move olFolder ' Move Copied item
            Set Mail.FlagStatus = olFlagComplete
        End If

        Set Item = Nothing
        'Set ItemCopy = Nothing
    End If
End Sub

vba outlook outlook-filter

0 commentaires

3 Réponses :

0
votes

La première tâche consiste à marquer tous les éléments terminés avec un drapeau vert au démarrage:

Private Sub Items_ItemAdd(ByVal Item As Object)  
    If TypeOf Item Is Outlook.MailItem Then
        Set Mail = Item

        If Mail.FlagStatus = olFlagMarked Then            
            Set Mail.FlagStatus = olFlagComplete
        End If        
    End If
End Sub

La deuxième partie consiste à gérer les éléments nouvellement ajoutés dans le dossier Completed :

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Dim olNameSpace As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder

    Set olNameSpace = Application.GetNamespace("MAPI")
    Set olFolder = olNameSpace.Folders("name@company.com")
    Set olFolder = olFolder.Folders("Completed")
    Set Items = olFolder.Items
    For Each Item In Items
      If TypeOf Item Is Outlook.MailItem Then
        Set Mail = Item

        If Mail.FlagStatus = olFlagMarked Then
            Set Mail.FlagStatus = olFlagComplete
        End If
      End If
     Next 

End Sub

1 commentaires

Merci pour la réponse. Lorsque je mets le code sur "ThisOutlookSession", puis fermez et ouvrez Outlook, rien ne se passe.

0
votes

Vous devez ensuite enregistrer le message - appelez Mail.Save après avoir défini la propriété FlagStatus .

0 commentaires

0
votes

Est-ce ce que vous essayez de faire?

Option Explicit
Private Sub Application_Startup()
    Dim Item As Object
    Mark_Items Item
End Sub

Private Function Mark_Items(ByVal Item As Object)
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim olShareName As Outlook.Recipient
    Set olShareName = olNs.CreateRecipient("0m3r@email.com")

    Dim olShareInbox As Outlook.folder
    Set olShareInbox = olNs.GetSharedDefaultFolder(olShareName, olFolderInbox)

    Dim Completed_Fldrs As Outlook.MAPIFolder
    Set Completed_Fldrs = olShareInbox.Folders("Completed")

    Dim Filter As String
        Filter = "@SQL=" & Chr(34) & _
                 "http://schemas.microsoft.com/mapi/proptag/0x10900003" & _
                           Chr(34) & ">1"

    Dim Items As Outlook.Items
    Set Items = Completed_Fldrs.Items.Restrict(Filter)

    Dim Mail As MailItem

    Dim i As Long
    For i = Items.Count To 1 Step -1
        DoEvents
        If TypeOf Items(i) Is Outlook.MailItem Then
            Set Mail = Items(i)
            Debug.Print Mail.Subject
            Mail.FlagStatus = olFlagComplete
            Mail.Save
        End If
    Next

End Function

4 commentaires

Affiche une erreur au démarrage d'Outlook. Impossible de trouver le dossier «Terminé». En déboguant, il affiche "Rien" pour le "Completed_Fldrs"

Pas vraiment, mais je peux généralement personnaliser le code selon mes besoins. Maintenant, le code fonctionne. Comme je peux le voir sur les forums, le problème était l'accès aux sous-dossiers d'une boîte aux lettres partagée. Je l'ai résolu avec cette ligne: "Set Completed_Fldrs = olNs.GetFolderFromID (" xxx ")". Pouvez-vous m'expliquer comment fonctionne le filtre, alors qu'est-ce qui est filtré exactement?

@IrinaG. voir les liens sur les réponses stackoverflow.com/a/43268976/4539709

Merci beaucoup. Votre aide ici est précieuse :)