Автоархивация всех папок в Outlook через скрипт
Добрый день!
Есть необходимость организовать архивирование сообщений в Outlook в локальные pst файлы.
Шаблоны для организации этого через GPO применены, но вопрос остался в том, что по умолчанию автоархивируются только папки Отправленные и Удаленные. А необходимо архивировать все папки пользователя со всеми родительскими папками и подпапками (делается при помощи нажатия на кнопку "Применить настройки ко всем папкам").
Нашел подобную тему http://social.technet.microsoft.com/...814a12c4b/-gpo где есть ссылка вот на этот скрипт Save Auto-Archive Properties of a Folder in Solution Storage
Код:
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 = _
"http://schemas.microsoft.com/mapi/proptag/0x6857000B"
Const PR_AGING_DELETE_ITEMS = _
"http://schemas.microsoft.com/mapi/proptag/0x6855000B"
Const PR_AGING_FILE_NAME_AFTER9 = _
"http://schemas.microsoft.com/mapi/proptag/0x6859001E"
Const PR_AGING_GRANULARITY = _
"http://schemas.microsoft.com/mapi/proptag/0x36EE0003"
Const PR_AGING_PERIOD = _
"http://schemas.microsoft.com/mapi/proptag/0x36EC0003"
Const PR_AGING_DEFAULT = _
"http://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 do not 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
1.Не пойму одного, что делает этот скритп и что нужно менять в нем, для того что бы применять его на своих доменных машинах?!
2. Или ни чего не надо менять в нем, т.к он работает со стандартными объектами Outlook?! |
