|VBOffice Reporter is an easy to use tool for data analysis and reporting in Outlook. A single click, for instance, allows you to see the number of hours planned for meetings the next month.|
The Archive feature is used in Outlook to move old items to an archive file or to delete them. You can set the settings for each folder: Right click the folder name, then choose Settings, AutoArchive. It's easy to forget some folders. And there's no built-in feature to see a summary of all the settings.
The following macros print such a list to the debug window (ctrl+g) of the VBA editor. Launch the function, for instance, by pressing ALT+F8, then select the start folder. The settings will be printed for the start folder and all its subfolders. If you have set a folder to be archived and the folder doesn't use the default settings, then the name of the archive file will be printed, too.
The meaning of 'Default settings' for a folder can be do archive, do not archive, or delete. As you can get the default settings quickly from the Options dialog, more code shouldn't be necessary. For those who want to get these settings by code as well, you'll find them in the Registry under HKEY_CURRENT_USER/Software/Microsoft/Office/xx.0/Outlook/Preferences. Replace 'xx' by your Outlook version.
To get this sample running you need to install the Redemption, which is free for private users. After the installation set a reference on the Redemption * Library via Tools/References.
Public Sub PrintAutoArchiveSettings() Dim Session As Redemption.RDOSession Dim Folder As Redemption.RDOFolder Set Session = CreateObject("redemption.rdosession") 'The following line works for OL 2003 and higher. For an older version 'call Session.Logon instead Session.MAPIOBJECT = Application.Session.MAPIOBJECT Set Folder = Session.PickFolder If Folder Is Nothing Then Exit Sub GetAgingProperties Folder, 0 LoopFolders Folder.Folders, True, 1 End Sub Private Sub LoopFolders(Folders As Redemption.RDOFolders, _ ByVal Recursive As Boolean, _ ByVal Indent As Long _ ) Dim Folder As Redemption.RDOFolder For Each Folder In Folders GetAgingProperties Folder, Indent If Recursive Then LoopFolders Folder.Folders, Recursive, Indent + 1 End If Next End Sub Private Sub GetAgingProperties(Folder As Redemption.RDOFolder, ByVal Indent As Long) On Error Resume Next Dim Item As Redemption.RDOMail Dim msg$ Const AGE_FOLDER As Long = &H6857000B Const DELETE_ITEMS As Long = &H6855000B Const FILE_NAME As Long = &H6859001E Const GRANULARITY As Long = &H36EE0003 Const AGING_PERIOD As Long = &H36EC0003 Const AGING_DEFAULT As Long = &H685E0003 If Folder.DefaultMessageClass = "IPM.Configuration" Then Exit Sub msg = String(Indent, vbTab) & Folder.Name & ": " Set Item = Folder.HiddenItems.Find("[MessageClass]='IPC.MS.Outlook.AgingProperties'") If Not Item Is Nothing Then If Item.Fields(AGE_FOLDER) = True Then Select Case Item.Fields(AGING_DEFAULT) Case 0, 1 If Item.Fields(DELETE_ITEMS) = True Then msg = msg & "Delete items" Else msg = msg & "Archive items" If Item.Fields(FILE_NAME) Then msg = msg & " (" & Item.Fields(FILE_NAME) & ")" End If End If Case 3 msg = msg & "Default settings" End Select ElseIf Item.Fields(AGING_DEFAULT) = 3 Then msg = msg & "Default settings" Else msg = msg & "Do not archive" End If Else msg = msg & "Do not archive" End If Debug.Print msg End Sub
|Determine the "identity" of your emails. Set with SAM the sender and the folder folder for sent items with the help of rules.|