CODEWITHSUNDEEP
vbaoutlookoutlook-2007
Keng
Keng

Reputation: 53101

How can I create a script to move the currently active email in the Inbox to another folder in Outlook 2007

I sometimes get emails that I want to keep but to move them into the appropriate folder can be a pain. How can I execute a script that will move (like using C-S-v) the email I'm looking at into a certain folder called "buffer", for instance?

I'm using Outlook 2007.

thanks.

EDIT: there isn't any criteria that can be created to automate this process like through a rule. it is merely a judgment call I make as i'm staring at it.

Upvotes: 3

Views: 9976

Answers (3)

Tom Ritter
Tom Ritter

Reputation: 101310

Tools -> Rules & Alerts

Then Create a new rule telling all mail that fit whatever criteria to be deleted/marked as read/moved to a folder/any combination of those.

Edit: If you don't want a rule/can't make a rule that fits, you can create a Macro (Tools -> Macro) to move it to a folder, then bind it to a shortcut.

Upvotes: 1

JimmyPena
JimmyPena

Reputation: 8754

This code may work better.

In your code, objFolder may be equal to Nothing, yet you continue the procedure. Also, the For Each loop assumes that each item is a mail item.

Sub MoveSelectedMessagesToFolder()
  Dim objNS As Outlook.NameSpace
  Dim objFolder As Outlook.MAPIFolder
  Dim obj As Object
  Dim msg As Outlook.mailItem

  Set objNS = Application.GetNamespace("MAPI")
  On Error Resume Next
  Set objFolder = objNS.Folders.item("Personal Folders").Folders.item("Buffer")
  On Error GoTo 0

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

  For Each obj In ActiveExplorer.Selection
    If TypeName(obj) = "MailItem" Then
      Set msg = obj
      msg.Move objFolder
    End If
  Next obj

End Sub

Upvotes: 5

Keng
Keng

Reputation: 53101

Here's the code I'm using.

Sub MoveSelectedMessagesToFolder()
'Originally written by Chewy Chong
'Taken from http://verychewy.com/archive/2006/04/12/outlook-macro-to-move-an-email-to-folder.aspx
'Thanks Chewy!
'Ken
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)
    'For the "Item" portion, I used the name of the folder exactly as it appear in the ToolTip when I hover over it.
    Set objFolder = objNS.Folders.Item("Personal Folders").Folders.Item("Buffer")

'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
                objItem.Move objFolder
            End If
        End If
    Next

Upvotes: 2

Related Questions