AutoArchive using VBA CDO CdoPR_AGING_PATH

[xx]

I am trying to programatically change the path to the archive file. My pst
has may folders and I dont want to change the path on each one by hand.

Using the code I can change the GRANULARITY and the PERIOD but the path wont
change. ( I am verifying the settings by right clicking the folder and
selecting AutoArchive).

I have tested in both Outlook 2002 and 2003. On 2003 I was able to change
the path when I ran the code the first time but subsequent attempt failed to
change the path.

Strangely when I view the path
(objMessage.Fields.Item(CdoPR_AGING_PATH).Value) via code after I change it,
it show the changed path but the AutoArchive tab show the old path.

Any suggestions?

Thanks in Advance

Below is some code I'm using...

' 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(1)
Set objRootFolder = objInfoStore.RootFolder
Set colFolders = objRootFolder.Folders

Set objFolCalendar = objSession.GetDefaultFolder(CdoDefaultFolderCalendar)
Set objFolContacts = objSession.GetDefaultFolder(CdoDefaultFolderContacts)
Set objFolDeleted =
objSession.GetDefaultFolder(CdoDefaultFolderDeletedItems)
Set objFolJournal = objSession.GetDefaultFolder(CdoDefaultFolderJournal)
Set objFolNotes = objSession.GetDefaultFolder(CdoDefaultFolderNotes)
Set objFolSent = objSession.GetDefaultFolder(CdoDefaultFolderSentItems)
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).Value = 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
Next

 

[wright1968]

I've been experimenting with these settings for the last few days. Based on what I have determined so far, the code you have should work for CUSTOM folder settings, but does not affect the default autoarchive settings.

For example, if you set your inbox to use the default autoarchive settings and your calendar to use Custom settings, then ran your script above to change both folder's archive location it WOULD work for the calendar folder but would NOT work on your inbox. You would not get an error though, because the CUSTOM PST path stored on the folder would have been updated correctly, it simply isn't being applied to the inbox because DEFAULT settings are being applied instead.

The following article will assist you with altering the path for the default folder. It requires editing the registry.

http://support.microsoft.com/kb/198479

On a side note... I am still looking for the location of the remaining default autoarchive settings. If anyone knows where they are, please let me know.