I AINT WORRYING ABOUT YOUR REPEAT CODE, BUT AS FOR THE
OBJECT ADD THIS, AND CHANGE TO READ
Quote:
Sub Arc()
' MAPI property tags for aging properties
Const CdoPR_AGING_PERIOD = &H36EC0003
Const CdoPR_AGING_GRANULARITY = &H36EE0003
Const CdoPR_AGING_PATH = &H6856001E
Const CdoPR_AGING_ENABLED = &H6857000B
Const CdoPR_AUTOARCHIVE_TYPE = &H685E0003
Const CdoPR_AGING_AGE_FOLDER = &H6857000B
Const CdoPR_CONTAINER_CLASS = &H3613001E
' Properties for aging granularity
Const AG_MONTHS = 0
Const AG_WEEKS = 1
Const AG_DAYS = 2
' Declare variables
Dim objSession As MAPI.Session
Dim objInfoStore As Object
'Dim objInboxFolder As MAPI.Folder
' CDO session logon
'Dim colFolders As MAPI.Folders
Set objInboxFolder = Nothing
Set objSession = New MAPI.Session
objSession.Logon "", "", ShowDialog:=True,
NewSession:=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(CdoDefaultFolderDelete dItems)
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
' Get hidden message collection
Set objHiddenMessages = objFolder.HiddenMessages
|||DIM objMessage
|
|||SET objMessage
|||SET objMessageHidden as objMessage
Quote:
' Loop through the hidden messages collection
For Each objMessage In objHiddenMessages
Select Case objFolder.ID
Case objFolInbox.ID
Case objFolOutbox.ID
Case objFolJournal.ID
Case objFolContacts.ID
Case objFolCalendar.ID
Case objFolDeleted.ID
Case objFolNotes.ID
Case objFolTasks.ID
Case objFolSent.ID
Case Else
|
Quote:
If Not objMessage.Type
= "IPC.MS.Outlook.AgingProperties" Then
objMessage.Add "IPC.MS.Outlook.AgingProperties"
End If
' Change the autoarchive mode (none,default,param)
objMessage.Fields.Item(CdoPR_AUTOARCHIVE_TYPE).Val ue
= 0
' Change aging properties to 14 months/weeks/days
objMessage.Fields.Item(CdoPR_AGING_PERIOD).Value = 3
' Change aging granularity to days
objMessage.Fields.Item(CdoPR_AGING_GRANULARITY).Va lue
= AG_MONTHS
' Change the path to the archive file
objMessage.Fields.Item(CdoPR_AGING_PATH).Value
= "C:\Temp\archive.pst"
' Enable aging for this folder
objMessage.Fields.Item(CdoPR_AGING_ENABLED).Value =
True
' Enable aging age for this folder
objMessage.Fields.Item(CdoPR_AGING_AGE_FOLDER).Val ue
= True
' Update hidden message
objMessage.Update True, True
'End If
End Select
Next
Next
End Sub
-----Original Message-----
I am trying to set the default autoarchive settings for
user created folders
within Outlook 2003 using the code below yet I keep
getting the error Object
doesn't support this property or method on the line:
objMessage.Add
"IPC.MS.Outlook.AgingProperties". Does anyone know what
is wrong here? I
would also like to change it to be recursive in case of
subfolders. Any
revised sample code would be appreciated.
Thanks,
Lando
------------------------------------------------
.
|