Re: Setting Folder Aging Properties Prob
I saved this as a .vbs and ran it. My infostore is item(2) because fo
some reason the Archive.pst listed first in my Outlook profile.
successfully run down the folders and hit on the hidden collections
but the location doesn't change. I have tried locations that ar
network shares and locations that are local.
' MAPI property tags for aging properties
Public Const CdoPR_AGING_PERIOD = &H36EC0003
Public Const CdoPR_AGING_GRANULARITY = &H36EE0003
Public Const CdoPR_AGING_PATH = &H6856001E
Public Const CdoPR_AGING_ENABLED = &H6857000B
' Properties for aging granularity
Public Const AG_MONTHS = 0
Public Const AG_WEEKS = 1
Public Const AG_DAYS = 2
Set objSession = CreateObject("MAPI.Session")
objSession.Logon "", "", True ,False
Set objInfoStore = objSession.InfoStores.Item(2)
Set objRootFolder = objInfoStore.RootFolder
Set colFolders = objRootFolder.Folders
Set objFolCalendar
objSession.GetDefaultFolder(CdoDefaultFolderCalend ar)
Set objFolContacts
objSession.GetDefaultFolder(CdoDefaultFolderContac ts)
Set objFolDelete
=objSession.GetDefaultFolder(CdoDefaultFolderDelet edItems)
Set objFolJournal
objSession.GetDefaultFolder(CdoDefaultFolderJourna l)
Set objFolNotes = objSession.GetDefaultFolder(CdoDefaultFolderNotes)
Set objFolSent
objSession.GetDefaultFolder(CdoDefaultFolderSentIt ems)
Set objFolTasks = objSession.GetDefaultFolder(CdoDefaultFolderTasks)
Set objFolInbox = objSession.GetDefaultFolder(CdoDefaultFolderInbox)
Set objFolOutbox = objSession.GetDefaultFolder(CdoDefaultFolderOutbox )
For Each objFolder In colFolders
'msgbox "here"
' Get hidden message collection
Set objHiddenMessages = objFolder.HiddenMessages
' Loop through the hidden messages collection
For Each objMessage In objHiddenMessages
'msgbox "here2"
' Check if the message class points to an aging message
If objMessage.Type = "IPC.MS.Outlook.AgingProperties" Then
' Change aging properties to 14 months/weeks/days
objMessage.Fields.Item(CdoPR_AGING_PERIOD).Value = 22
' Change aging granularity to days
objMessage.Fields.Item(CdoPR_AGING_GRANULARITY).Va lue = AG_DAYS
' Change the path to the archive file
objMessage.Fields.Item(CdoPR_AGING_PATH).Value = "c:\archive.pst"
' Enable aging for this folder
objMessage.Fields.Item(CdoPR_AGING_ENABLED).Value = True
' Update hidden message
objMessage.Update True, True
End If
Next
Nex
|