通过

在解决方案存储中保存文件夹的自动存档属性

  • 项目

本主题介绍一种将其私有数据保存在几个 MAPI 自动存档属性中的解决方案。 解决方案将这些属性存储在应用自动存档属性的文件夹的 StorageItem 对象中。 StorageItem 对象作为隐藏数据存储在文件夹的相关部分中，因为这些解决方案可以通过可选方式加密其数据，因此它们为解决方案数据提供了必需的隐私保护功能。 由于 MAPI 自动存档属性在 Outlook 对象模型中未公开为显式内置属性，因此解决方案使用 StorageItem 对象上的 PropertyAccessor 来设置这些属性。

下面对此过程进行了说明：

  1. 函数 ChangeAgingProperties 接受以下内容作为输入参数：

  • oFolder 是应用时效属性并存储这些属性值的 Folder 对象。

  • AgeFolder 指示是否根据指定对文件夹中的项目进行存档或将其删除。

  • DeleteItems 指示是否删除（而不是存档）早于存在周期的项目。

  • FileName'指示用于存档过期项的特定文件。 如果它是一个空字符串，则会使用默认的存档文件 archive.pst。

  • Granularity 指示用于计算存在周期的时间单位，存档是以月、周还是日为单位进行计算。

  • Period 指示以给定精度表示的时间量。 同时， Granularity 和 Period 值指示存在周期。 给定文件夹中早于此存在周期的项目需要根据指定进行存档或者被删除。 例如，若 Granularity 为 2 且 Period 为 14，则指定存在周期为 14 天，如果给定文件夹中的项目超过了 14 天，则应根据指定进行存档或者删除。

  • Default 指示应将哪些设置设为默认值。 可能的值为 0、1 和 3：

    • 0 指示不将任何设置假定为默认值。

    • 1 指示仅将文件位置假定为默认值。 这与在文件夹的 "属性" 对话框的 "自动存档" 选项卡中选择 "使用这些设置保存此文件夹" 和 "将旧项目移至默认存档文件夹" 的作用相同。

    • 3 指示将所有设置假定为默认值。 这与在文件夹的 "属性" 对话框的 "自动存档" 选项卡上选择 "使用默认设置保存文件夹中的项" 的作用相同。

  1. 检查参数的有效性。

  2. 如果参数有效，则会使用 Folder.GetStorage 来创建或获取具有邮件类 IPC.MS.Outlook.AgingProperties 的现有 StorageItem 对象。

  3. 然后使用 PropertyAccessor 对 StorageItem 设置自动存档属性，并使用 StorageItem.Save 保存对 StorageItem 的更改。

  4. 此过程 TestAgingProps 设置当前文件夹的老化属性的自动存档设置，以便将超过 6 个月的项目移动到默认存档文件。

备注

  1. 将代码放在内置的 ThisOutlookSession 模块中。

  2. TestAgingProps运行过程，在活动资源管理器中的当前文件夹上设置老化属性。

注意 无论是作为 VBA 宏还是 COM 加载项实现，解决方案都是受信任的调用方，因此可以访问 PropertyAccessor。 为了改进此示例，请将以下 VBA 代码包括在一个 .NET 类中，以便更好地捕获错误和枚举 Granularity 。

Function ChangeAgingProperties(oFolder As Outlook.Folder, _ 
 AgeFolder As Boolean, DeleteItems As Boolean, _ 
 FileName As String, Granularity As Integer, _ 
 Period As Integer, Default As Integer) As Boolean 
 
 '6 MAPI properties for aging items in a folder 
 Const PR_AGING_AGE_FOLDER = _ 
 "https://schemas.microsoft.com/mapi/proptag/0x6857000B" 
 Const PR_AGING_DELETE_ITEMS = _ 
 "https://schemas.microsoft.com/mapi/proptag/0x6855000B" 
 Const PR_AGING_FILE_NAME_AFTER9 = _ 
 "https://schemas.microsoft.com/mapi/proptag/0x6859001E" 
 Const PR_AGING_GRANULARITY = _ 
 "https://schemas.microsoft.com/mapi/proptag/0x36EE0003" 
 Const PR_AGING_PERIOD = _ 
 "https://schemas.microsoft.com/mapi/proptag/0x36EC0003" 
 Const PR_AGING_DEFAULT = _ 
 "https://schemas.microsoft.com/mapi/proptag/0x685E0003" 
 
 Dim oStorage As StorageItem 
 Dim oPA As PropertyAccessor 
 
 ' Valid Period: 
 ' 1-999 
 ' 
 ' Valid Granularity: 
 ' 0=Months, 1=Weeks, 2=Days 
 ' 
 ' Valid Default: 
 ' 0=All settings don't use a default setting 
 ' 1=Only the file location is defaulted 
 ' "Archive this folder using these settings" and 
 ' "Move old items to default archive folder" are checked 
 ' 3=All settings are defaulted 
 ' "Archive items in this folder using default settings" is checked 
 
 If (oFolder Is Nothing) Or _ 
 (Granularity < 0 Or Granularity > 2) Or _ 
 (Period < 1 Or Period > 999) Or _ 
 (Default < 0 Or Default = 2 Or Default > 3) _ 
 Then 
 ChangeAgingProperties = False 
 End If 
 
 On Error GoTo Aging_ErrTrap 
 
 'Create or get solution storage in given folder by message class 
 Set oStorage = oFolder.GetStorage( _ 
 "IPC.MS.Outlook.AgingProperties", olIdentifyByMessageClass) 
 Set oPA = oStorage.PropertyAccessor 
 
 If Not (AgeFolder) Then 
 oPA.SetProperty PR_AGING_AGE_FOLDER, False 
 Else 
 'Set the 6 aging properties in the solution storage 
 oPA.SetProperty PR_AGING_AGE_FOLDER, True 
 oPA.SetProperty PR_AGING_GRANULARITY, Granularity 
 oPA.SetProperty PR_AGING_DELETE_ITEMS, DeleteItems 
 oPA.SetProperty PR_AGING_PERIOD, Period 
 If FileName <> "" Then 
 oPA.SetProperty PR_AGING_FILE_NAME_AFTER9, FileName 
 End If 
 oPA.SetProperty (PR_AGING_DEFAULT), Default 
 End If 
 'Save changes as hidden messages to the associated portion of the folder 
 oStorage.Save 
 ChangeAgingProperties = True 
 Exit Function 
 
Aging_ErrTrap: 
 Debug.Print Err.Number, Err.Description 
 ChangeAgingProperties = False 
End Function 
 
Sub TestAgingProps() 
 Dim oFolder As Outlook.Folder 
 Set oFolder = Application.ActiveExplorer.CurrentFolder 
 If ChangeAgingProperties(oFolder, True, False, "", 0, 6, 1) Then 
 Debug.Print "ChangeAgingProperties OK" 
 Else 
 Debug.Print "ChangeAgingProperties Failed" 
 End If 
End Sub

支持和反馈

有关于 Office VBA 或本文档的疑问或反馈？ 请参阅 Office VBA 支持和反馈，获取有关如何接收支持和提供反馈的指南。