none
VBS скрипт настройки архивации почтового ящика RRS feed

  • Вопрос

  • Добрый день.

    Нужна помощь зала...

    Есть скрипт, применяется он к стандартным папкам...Но как сделать чтоб он применялся ко всем? Ведь юзер может создать много личных папок в Outlook, а данный скрипт работает только со стандартным набором.

    Буду очень благодарен:)

    On Error Resume Next
    ' Properties for aging granularity
    Const AG_MONTHS = 0
    Const AG_WEEKS = 1
    Const AG_DAYS = 2
    Const AutoArchivePolicy=3
    Const UserDefinedPolicy=1
    Const strProptagURL = "http://schemas.microsoft.com/mapi/proptag/0x"
     
    '------------------------------------------------------------------------------
    '
    ' String values for the Exchange properties that govern aging / archiving
    '
    '------------------------------------------------------------------------------
    strPR_AGING_AGE_FOLDER = strProptagURL + "6857000B"
    strPR_AGING_PERIOD = strProptagURL + "36EC0003"
    strPR_AGING_GRANULARITY = strProptagURL + "36EE0003"
    strPR_AGING_DELETE_ITEMS = strProptagURL + "6855000B"
    strPR_AGING_FILE_NAME_AFTER9 = strProptagURL + "6859001E"
    strPR_AGING_DEFAULT = strProptagURL + "685E0003"
     
    CONST Deleted = 3
    CONST Outbox = 4
    CONST Sent = 5
    CONST Inbox = 6
    CONST Calendar = 9
    CONST Contacts = 10
    CONST Journal = 11
    CONST Notes = 12
    CONST Tasks = 13
    CONST Drafts = 16
    Const olIdentifyByMessageClass = 2
    Set app=Createobject("Outlook.Application")
    Set namespace = app.GetNamespace("MAPI")
     
     
    Set objRootFolder=namespace.GetDefaultFolder(Inbox)
    AgeMe objRootFolder
    Set objRootFolder=namespace.GetDefaultFolder(Outbox)
    AgeMe objRootFolder
    Set objRootFolder=namespace.GetDefaultFolder(Sent)
    AgeMe objRootFolder
    Set objRootFolder=namespace.GetDefaultFolder(Deleted)
    AgeMe objRootFolder
    Set objRootFolder=namespace.GetDefaultFolder(Drafts)
    AgeMe objRootFolder
    Set objRootFolder=namespace.GetDefaultFolder(Tasks)
    AgeMe objRootFolder
    Set objRootFolder=namespace.GetDefaultFolder(Journal)
    AgeMe objRootFolder
    Set objRootFolder=namespace.GetDefaultFolder(Notes)
    AgeMe objRootFolder
     
     
    Wscript.Quit
     
     
    Sub AgeMe(objFolder)
        On Error Resume Next
        Age objFolder
        Set colSubFolders=objFOlder.Folders
        For Each objSubFolder In colSubFolders
            AgeMe objSubFolder
        Next
    End Sub
     
    Function Age(objFolder)
     
     
     
        Granularity = AG_MONTHS
        DeleteItems = False
        Period = 3
        Policy = AutoArchivePolicy
     
     
     
        On Error Resume Next
        Age=False
        Set oStorage = objFolder.GetStorage("IPC.MS.Outlook.AgingProperties", olIdentifyByMessageClass)
        Set oPA = oStorage.PropertyAccessor
        oPA.SetProperty strPR_AGING_AGE_FOLDER, True
        oPA.SetProperty strPR_AGING_GRANULARITY, Granularity
        oPA.SetProperty strPR_AGING_DELETE_ITEMS, DeleteItems
        oPA.SetProperty strPR_AGING_PERIOD, Period
        oPA.SetProperty strPR_AGING_DEFAULT, Policy
        oStorage.Save
        Age = True
    End Function

    1 марта 2018 г. 15:20