vba - Outlook VBAでメールアイテムに保持タグを割り当てる方法は?

Question

いくつかの複雑な基準に基づいていくつかのアイテムに保持タグ ( docs ) を割り当てる Outlook のフォルダーを通過するマクロを作成しようとしています。

VBAでこれを行う方法がわかりません。これまでのところ、メール アイテムにはいくつかの保持関連のプロパティ ( PidTagPolicyTag( docs ) など) があることを学びましたが、それらを適切に処理する方法はまだわかりません。

これらと一緒に使用する例は何ですか?

Answer 1

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