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