create a macro to move outlook 2003 message to a specific folder?

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I need a second message 'delete' button that doesn't truly delete a message
but moves it to a specified folder. Has anyone already written an Outlook
2003 macro to do this? (Why Microsoft refuses to put a 'learn' function into
Outlook to jump start macro building is beyond me.)

The reason is that I concurrently manage two on-line 'personalities' for
different employers and do not want the messages from one personality
auto-archived to the other personality's archive files.

I can auto-segregate incoming messages by email account, I can
auto-segregate out-going messages by email account using the Rules Wizard -
but I cannot do this with deleted messages. (for legal reasons, I never
actually delete anything).
 
If you are essentially just moving the message rather than deleting it, would
using the File -> Move To Folder... command inside the message (or
right-click the message, Move To Folder... / Edit -> Move To Folder... in the
folder view) be sufficient for your needs?

If it is the same folder you are always moving the message to, you can use
the Item.Move(DestinationFolder As MAPIFolder Object) method to move the
message to a previously declared MAPIFolder variable.
 
Well thanks, but that is only half the answer I was looking for.

I know about the 'Move to Folder' option. It is what I am doing now and
takes twice as much work as I am looking for because you have to both select
the function, then select the destination.

And yes, I am looking to move these items every time to the same folder
using an icon or keyboard shortcut. As for the macro - thanks for the key
piece - but I believe it takes a bit more code to complete the macro.

In every other Office app, I could simply record a function this simple and
be done - but NOT in Outlook. I am capable of hand writing my own VBA
routine, but as I don't routinely do this, it always takes me much longer
than necessary. I was hoping somebody out there had already invented this
wheel and would be willing to share.
 
Not true. Most of today's growing number of Office applications do not have
macro recorders. The document-centric programs Word, Excel, and PowerPoint
are the exceptions, not the majority.

--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



"Jim Johnson - Serenity Consulting"
 
My apologies. I work mostly in Word, Excel and on occasion Access - all of
which build most of the macro code for you. For simple stuff, you at most
need to tweak a couple lines.
 
Not functionality - there is only one action. You missed the point. The goal
was to NOT reinvent a complete macro - just paste it all in. Your one line
may help me figure out which method is needed, but it sure as heck isn't a
complete macro.

Oh well, thanks anyhow - when I have some extra time I'll re-teach myself VBA.
 
Well, there is virtually no "simple stuff" in Outlook, at least not until
you master the fundamental concepts.

--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers



"Jim Johnson - Serenity Consulting"
 
If your goal was not to "reinvent" a macro but to have it automatically
created for you, then of course you are out of luck because there is no macro
recorder in Outlook. The only recourse we have is to hand-roll our own
solutions, which isn't terribly difficult with Outlook VBA, and that's where
this newsgroup comes in for assisting people who are having problems taming
the Outlook programming model beast.

I thought you had already begun the process of coding the solution, so I
gave you a quick pointer rather than write the code for you. Regardless,
below is the solution to your issue that I can share with you - it took all
of five minutes. It assumes the destination folder is under your Inbox, but
you can always tweak it for another location.

Sub MoveOpenedMessageToFolder()
On Error Resume Next

Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objInbox.Folders("Some Folder Under The Inbox") '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.ActiveInspector Is Nothing Then
'Require that this procedure be called for an open item
Exit Sub
End If

If Application.ActiveInspector.CurrentItem.Class <> olMail Then
Exit Sub
End If

Application.ActiveInspector.CurrentItem.Move objFolder

Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub
 
Thanks for your help Eric. Your macro doesn't quite do what I want - but it
is very close! I'll use it as a basis when I get around to dusting off my VBA
programming skills.

The destination folder is not under the Inbox, but co-equal in the folder
tree (a minor issue). The other is that I use the preview panel and only
fully open a message when absolutely necessary. I need to run the macro
against the selected message in the current mail folder.

Meanwhile I'll have to use the two step "Move to another folder" then select
the intended folder.

Thanks for trying.
 
Okay, now that I know exactly what you want, I've altered the macro to handle
any selected messages in the current folder, and to look for the folder name
that you specify underneath the root of the same store containing your Inbox:

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("Some Folder Under The Root")
'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

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

--
Eric Legault - B.A, MCP, MCSD, Outlook MVP
--------------------------------------------------
{Private e-mails ignored}
Job: http://www.imaginets.com
Blog: http://blogs.officezealot.com/legault/
 
PERFECT!!

I really didn't expect someone to craft a macro - I strongly suspect someone
has run into this issue before, and I was hoping they would share.

I built an appropriate icon and keyboard shortcut, now I'm all set.

Jim Johnson
 
Hi Eric-

Your macro works very well as a button on the Outlook toobar. However, I did
need to make a very slight alteration to accomodate Read Receipts. Using the
properties function, I noted that Outlook doesn't view them as messages, but
reports. (in my business read receipts are a cheap CYA umbrella during
periodic blame storms) I then used the help function to track down this
object type.

I'm sure both objects could be handled within one loop structure with an
elseif, but as small as this macro is, down and dirty code using a copy and
paste works just as well.

Sub xDeleteMLS()
On Error Resume Next

Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem, objReport
As Outlook.ReportItem

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objInbox.Parent.Folders("Delete MLS") '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

For Each objReport In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objReport.Move objFolder
End If
End If
Next

Set objItem = Nothing
Set objReport = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub
'courtesty Eric Legault - B.A, MCP, MCSD, Outlook MVP
 
Eric you are truly an Outlook VBA genius!

This macro is very close to what I need. Here is what this inept Outlook
VBA person needs (that's me!)

In the subject line of a message a number will exist that represents a
public folder name. For example the subject line of the email message might
be ABC company 123.001. I want the macro to find the number and move the
message into the corresponding public folder name.
 
Can you provide a variation of this macro that will move the emails to a
folder on a "personal folder" (PST) file instead?

Auto Archive lets me do this on a scheduled basis but I need to be able
to move emails manually. The solution you provided gets me there with
the adjustment above.

Thank you

GusDarino
 
What solution? The newsgroup interface you are using apparently does not
quote earlier messages in the thread, making your latest message way too
short on detail. Please take the time to quote the original message.
 
This is perfect, I was just trying to make this today. I blended your first
and altered code to do exactly what I wanted.

I havent done any code or macro in Outlook so excuse the ignorance. It is
saved now in -VbaProject.OTM - ThisOutlookSession (Code)
Is this where I want it?
Will it be available everytime I open outlook in its current location?

Thank you,
Chris
 
Hey Eric
I had a look at this post and I have modified the code to move an email that
I am sending into a temporary folder if I dont think that I will need. It
works fine on a new email but for forwarded mails (go figure!) gives an error
message "The Send operation failed because the item was deleted before it was
sent". It does send the mail to the "TEMP SENT" folder though. Any ideas what
is causing this? My code:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim answer As Long
Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace

If Item.Class = olMail Then
answer = MsgBox("SAVE subj: " & Item.Subject & " to Sent Items?", vbYesNo)
If answer = vbNo Then
On Error Resume Next
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objInbox.Folders("TEMP SENT")

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

If Application.ActiveInspector Is Nothing Then
'Require that this procedure be called for an open item
Exit Sub
End If

If Application.ActiveInspector.CurrentItem.Class <> olMail Then
Exit Sub
End If

Application.ActiveInspector.CurrentItem.Move objFolder

Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End If
End If
End Sub
 
Eric,

And here we have more living proof that archiving older posts can certainly
be helpful.

This is exactly what I needed, as well ...... 4 years later.

Works like a charm in Office 2007. ;-)

Thanks! You just saved me some coding legwork.

Alex Craig
 
Sue,

Don't know if you are still monitoring this (3 years later), but just in
case, here's my .02.

Your point actually underscores the need for a macro recorder in Outlook.
Word and Excel are inarguably the most popular and prolific Office
applications. They have macro recorders to help individuals automatic
regular manual tasks. Outlook is by far and away the next most popular
Office app. As you said, there is "virtually no simple stuff" in Outlook
coding- hence all the more reason to assist users in creating macros and VBA
code by including a macro recorder.

C Watson
 
Back
Top