View Single Post
 
Old 02-28-2005, 04:20 PM
Lando
Guest
 
Posts: n/a
Default Re: Setting Folder Aging Properties Prob

Thanks for the information! Unfortunately I'm not that experienced with VB.
I've looked at the code from the links you gave me and below is what I have
written on my own. I keep getting the error [Collaboration Data Objects -
[MAPI_E_NOT_FOUND(8004010F)] when I run the code below.
If I change:
Set objField = objFields.Item(CdoPR_AGING_FILENAME)
to
Set objField = objFields.Item(CdoPR_AUTOARCHIVE_TYPE)
or any other value it works.

I know I'm asking alot but does anyone have some sample code or could modify
my code below that would apply archive settings to a folder or all folders
in a mailbox with the values I chose? It seems I keep missing things I think
a savvy programmer would catch and could do much faster than I could ever
hope to.

Thanks again for all your help! I really appreciate it!

Lando
----------------------------------------------

Sub LandoCode()

' 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
Const CdoPR_AGING_FILENAME = &H6856001E

' 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 objHiddenMessages As MAPI.Messages
Dim objMessage As MAPI.Message
Dim objFields As MAPI.Fields

' Initialize variables
Set objSession = Nothing
Set objInboxFolder = Nothing

' Create CDO session and logon
Set objSession = New MAPI.Session

' CDO session logon
objSession.Logon "", "", ShowDialog:=True, NewSession:=False

' Get the inbox folder of a mailbox
Set objFolder = objSession.Inbox

' Get the hidden messages collection
Set objMessages = objFolder.HiddenMessages

' Loop through the hidden messages
For Each objMessage In objMessages

' Check the message class
If objMessage.Type = "IPC.MS.Outlook.AgingProperties" Then
MsgBox (objMessage.Type)
Set objFields = objMessage.Fields

Set objField = objFields.Item(CdoPR_AGING_FILENAME)
MsgBox (objField.Value)

' For Each objField In objFields
' MsgBox (objField.Value)
' Next
End If
Next

End Sub
Reply With Quote