Listing 3: Code to Move Important Items to a Public Folder

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
	Dim objNS as Namespace
	Dim objPF as MAPIFolder
	Dim objAPF as MAPIFolder
	Dim objIT as MAPIFolder
	Dim objImportantFolder As MAPIFolder	


	If Item.Class = olMail Then
	If Item.Importance = olImportanceHigh Then
	Set objNS = Application.GetNamespace("MAPI")
	On Error Resume Next
	Set objPF = objNS.Folders("Public Folders")
	Set objAPF = objPF.Folders("All Public Folders")
	Set objIT = objAPF.Folders("IT")
	Set objImportantFolder = objIT.Folders("Important")
	Item.Move objImportantFolder
	End If
	End If
	On Error GoTo 0
	
	Set objImportantFolder = Nothing
	Set objIT = Nothing
	Set objAPF = Nothing
	Set objPF = Nothing
	Set objNS = Nothing
End Sub