Gmail my Outlook

I'm a pack-rat when it comes to e-mail. Somewhere I have e-mail saved from 1992 from my VAX account from college. That's why I loved Gmail when it came out - tons of storage and an archive button... I got really hooked on the Archive button.

...so much so that I decided I needed one for my Outlook at work. Here is my code. I attached it to my archive button in the screenshot...



----code starts here

Sub MoveSelectedMessagesToFolder()
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 = objInbox.Parent.Folders("Archive") '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
'Only call 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
If objItem.FlagStatus = olFlagComplete Then
objItem.FlagStatus = olFlagMarked
' objItem.FlagIcon = olPurpleFlagIcon
objItem.Move objFolder
objItem.FlagStatus = olFlagComplete
objItem.FlagIcon = olNoFlagIcon
objItem.Save
Else
objItem.Move objFolder
End If
End If
End If
Next

Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub

----code ends here

Corey