Outlook 2010: Macro for Moving Selected Items

It has been a really long time since I wrote Microsoft Outlook VBA code. But when a customer last week asked me if there was a way to write some VBA code to move selected Inbox items to an Archive folder, I felt right at home. Here's what I came up with for him:

 Sub ArchiveItems()

    ' Moves each of the selected items on the screen to an Archive folder.
    Dim olApp As New Outlook.Application
    Dim olExp As Outlook.Explorer
    Dim olSel As Outlook.Selection
    Dim olNameSpace As Outlook.NameSpace
    Dim olArchive As Outlook.Folder
    Dim intItem As Integer

    Set olExp = olApp.ActiveExplorer
    Set olSel = olExp.Selection
    Set olNameSpace = olApp.GetNamespace("MAPI")
    ' This assumes that you have an Inbox subfolder named Archive.
    Set olArchive = olNameSpace.GetDefaultFolder(olFolderInbox).Folders("Archive")

    For intItem = 1 To olSel.Count
        olSel.Item(intItem).Move olArchive
    Next intItem

End Sub