Wednesday, September 8, 2010

Outlook 2007 Move to Folder Under Inbox

Part two of the Email Management series. This macro code moves a message item from the Inbox to a folder under the Inbox. Two versions of this macro exist in my setup to move items to the Actions or Review folders.

Sub moveReview()
On Error Resume Next
Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.Namespace, objItem As Outlook.MailItem

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objNS.GetDefaultFolder(olFolderInbox).Folders.Item("Folder")
'Assume this is a mail folder

If objFolder Is Nothing Then
MsgBox "This folder doesn’t exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
End If

If Application.ActiveExplorer.Selection.Count = 0 Then
'Require that this procedure be called only when a message is selected
Exit Sub
End If

For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
'Set item as read.
'objItem.UnRead = False
objItem.Move objFolder
End If
End If
Next

Set objItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing

End Sub

No comments:

Post a Comment