How to assign a retention tag to a mail item in Outlook VBA?

问题

I'm trying to write a macro which will be going through a folder in Outlook assigning a retention tag (docs) to some items based on some complicated criteria.

I don't know how to do this in VBA. So far I've learned that mail items have some retention related properties (PidTagPolicyTag (docs), etc.), but I still don't know how to deal with them properly.

What would be some examples of using with these?

回答1:

Take a look at existing message with those properties set using OutlookSpy (click IMessage) or MFCMAPI. The properties can be set using MailItem.PropertyAccessor.SetProperty.

回答2:

Here is an example of applying a retention tag to messages using Outlook VBA:

Option Explicit

Private Sub Application_Startup()
    Const retPolicy7Y As String = "C16486BDBB1B384C9BDE0C2479537191" 'Document Retention  -  07 Years (7 years)
    Const retPeriod As Long = 2555 '7*365 days
    Dim mapi As NameSpace, sentItems As Items, cutOffDate As Date
    Dim i As Long, pa As PropertyAccessor, p As Variant, isEqual As Boolean, msgDate As Variant

    Set mapi = GetNamespace("MAPI")
    Set sentItems = mapi.GetDefaultFolder(olFolderSentMail).Items
    sentItems.Sort "SentOn", True
    cutOffDate = Now - 14

    For i = 1 To sentItems.Count
        If sentItems(i).SentOn <= cutOffDate Then
            Exit For
        End If

        Set pa = sentItems(i).PropertyAccessor
        p = Empty
        On Error Resume Next
        p = pa.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x30190102") 'Get PR_POLICY_TAG
        On Error GoTo 0

        If IsEmpty(p) Then
            isEqual = False
        ElseIf pa.BinaryToString(p) <> retPolicy7Y Then
            isEqual = False
        Else
            isEqual = True
        End If

        If Not isEqual Then
            msgDate = Empty
            On Error Resume Next
            msgDate = pa.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E060040") 'Get PR_MESSAGE_DELIVERY_TIME
            On Error GoTo 0
            If IsEmpty(msgDate) Then
                msgDate = pa.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x30070040") 'Get PR_CREATION_TIME
            End If

            pa.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x30190102", pa.StringToBinary(retPolicy7Y) 'Set PR_POLICY_TAG
            pa.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x301A0003", retPeriod 'Set PR_RETENTION_PERIOD
            pa.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x301C0040", msgDate + retPeriod 'Set PR_RETENTION_DATE
            sentItems(i).Save
        End If
    Next i
End Sub

来源：https://stackoverflow.com/questions/27011942/how-to-assign-a-retention-tag-to-a-mail-item-in-outlook-vba

标签

vba

outlook-vba

retention