ソリューション ストレージにフォルダーの自動アーカイブ プロパティを保存する
このトピックでは、プライベート データをいくつかの MAPI 自動アーカイブ プロパティに保存するソリューションを示します。 ソリューションは、自動アーカイブ プロパティが適用されるフォルダーの StorageItem オブジェクトにこれらのプロパティを格納します。 StorageItem オブジェクトは、フォルダーの関連付けられた部分に非表示のデータとして格納され、ソリューションは必要に応じてデータを暗号化できるため、ソリューション データに必要なプライバシーを提供します。 MAPI 自動アーカイブ プロパティは Outlook オブジェクト モデルで明示的な組み込みプロパティとして公開されないため、ソリューションでは StorageItem オブジェクトの PropertyAccessor を使用してこれらのプロパティを設定します。
この手順は次のとおりです。
- 関数は
ChangeAgingProperties
、入力パラメーターとして次を受け入れます。
oFolder
は、保存期間プロパティを適用し、その値を保存する フォルダー オブジェクトです。AgeFolder
には、フォルダー内のアイテムを指定どおりに整理または削除するかを設定します。DeleteItems
には、保存期間を過ぎたアイテムを整理せずに、削除するかどうかを指定します。FileName' は、期限切れのアイテムをアーカイブするための特定のファイルを示します。 空の文字列を指定すると、既定の保存ファイル archive.pst が使用されます。
Granularity
には、保存期間の単位を指定します。つまり、保存期間の計算を月、週、または日単位で行うかを指定します。Period
には、単位の期間を指定します。Granularity
およびPeriod
の値を組み合わせて保存期間を指定します。 特定のフォルダーで、この保存期間を過ぎたアイテムは、指定どおりに整理または削除されます。 たとえば、Granularity
が 2 でPeriod
が 14 の場合、保存期間は 14 日となり、フォルダーで 14 日を過ぎたアイテムは、指定どおりに整理または削除されます。Default
では、どの設定を既定値に設定する必要があるかを指定します。 有効な値は、0、1、および 3 です。0 は、何も既定値を前提としないことを示します。
1 は、ファイルの場所のみ既定値を前提とすることを示します。 これは、フォルダーの [ プロパティ] ダイアログ ボックスの [ 古いアイテムの整理] タブで、[ 以下の設定でこのフォルダーを保存する] チェック ボックスおよび [ 古いアイテムを既定の保存フォルダーに移動する] チェック ボックスをオンにするのと同じです。
3 は、すべての設定が既定値を前提とすることを示します。 これは、フォルダーの [ プロパティ] ダイアログ ボックスの [ 古いアイテムの整理] タブで、[ 既定の設定を使用してこのフォルダーにアイテムを保存する] チェック ボックスをオンにするのと同じです。
パラメーターが有効かどうかが調べられます。
パラメーターが有効である場合、 Folder.GetStorage を使用して、メッセージ クラス IPC.MS.Outlook.AgingProperties を持つ既存の StorageItem オブジェクトを作成または取得します。
次に、PropertyAccessor を使用して StorageItem の自動アーカイブ プロパティを設定します。 StorageItem.Save は StorageItem への変更を保存するために使用されます。
この手順では
TestAgingProps
、現在のフォルダーのエージング プロパティの自動アーカイブ設定を設定して、6 か月より前のアイテムが既定のアーカイブ ファイルに移動されるようにします。
注釈
コードは、組み込みの ThisOutlookSession モジュールに配置します。
プロシージャを
TestAgingProps
実行して、アクティブなエクスプローラーの現在のフォルダーにエージング プロパティを設定します。
メモ VBA マクロまたは COM アドインとして実装されている場合でも、ソリューションは信頼できる呼び出し元であるため、 PropertyAccessor にアクセスできます。 この例を改善するには、次の VBA コードを .NET クラスでラップして、 粒度のエラー トラップと列挙を改善します。
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 のサポートおよびフィードバックを参照してください。