Highlight And Move Multiple Emails

Okay so I said I would be writing some VBA code to export contacts and emails from Outlook to Excel, well, I lied, sort of. That code is still coming, but before I post it, here is a routine that lets you run VBA code on multiple messages at the same time. Most of my routines so far have been written to run on one email at a time:

Resend This Message
Save Incoming Attachments
Read those image files in Outlook

and so on.

This macro is perfect for manual execution of a routine on multiple emails. In the example below, I select a few emails from my Inbox and then move them to another folder. You could easily adapt this macro to forward all the selected messages, save attachments from all of them, etc.

Sub MoveToFolder()

Dim olMyFldr As Outlook.MAPIFolder
Dim MsgColl As Object
Dim Msg As Outlook.MailItem
Dim objNS As Outlook.NameSpace
Dim i As Long

' check if we have multiple items selected
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
    Case "Explorer"
        ' a collection of selected items
        Set MsgColl = ActiveExplorer.Selection
    Case "Inspector"
        ' only one item was selected
        Set Msg = ActiveInspector.CurrentItem
End Select
On Error GoTo 0

If (MsgColl Is Nothing) And (Msg Is Nothing) Then
    GoTo ExitProc
End If

Set objNS = Outlook.GetNamespace("MAPI")
Set olMyFldr = objNS.GetDefaultFolder(olFolderInbox).Folders(”Completed”)

' now we can act on the msg collection,
' or on the individual msg we selected

If Not MsgColl Is Nothing Then
' we selected multiple items
    For i = 1 To MsgColl.Count
       ' set an obj reference to each mail item so we can move it
        Set Msg = MsgColl.Item(i)
            With Msg
                .UnRead = False
                .Move olMyFldr
            End With
    Next i
ElseIf Not Msg Is Nothing Then
    With Msg
        .UnRead = False
        .Move olMyFldr
    End With
End If

ExitProc:
Set Msg = Nothing
Set MsgColl = Nothing
Set olMyFldr = Nothing
Set objNS = Nothing
End Sub

Rows 36-39 and 43-44 are the sections you would replace with your own code. The first
part (right after "Set Msg = MsgColl.Item(i)") is the one that loops through each
selected message and runs your code. So you can move, forward, copy, export, reply
with attachments, etc, each mail item you selected. The second one runs only if one
mail item is selected.

In both cases, the object variable "Msg" is a reference to the current mail item.
That's what you will be manipulating.

If you're saving attachments, for extra credit try adding the SelectFolder() Function
from the Save Incoming Attachments post.

Enjoy,
JP

Related Articles:

• December 29, 2011 -- Len vs blank strings vs vbNullString
• September 7, 2009 -- Checking Access Database Properties using VBA
• August 24, 2010 -- Get Data Validation Range