Move email to specific folder in 2003?

[Mick]

I found a thread that has code on how to do what I'm trying to do, but
I'm missing something and it won't work. I know the macro is running,
becasue if I have the folder name I do get the eror message coded in
it. Can somone sugest where I might be going wrong. Here's the code and
the previous thread:

Oh yea, I didn't see where you assign a 'hot key' to a macro in outlook
either...

Thanks!

Mick
------------------------------------------

Eric Legault [MVP - Outlook]
Dec 11 2004, 1:47 am show options
Newsgroups: microsoft.public.outlook.program_vba
From: "Eric Legault [MVP - Outlook]" <[email protected]> -
Find messages by this author
Date: Fri, 10 Dec 2004 22:47:02 -0800
Local: Sat, Dec 11 2004 1:47 am
Subject: RE: create a macro to move outlook 2003 message to a specific
fold
Reply to Author | Forward | Print | Individual Message | Show original
| Report Abuse

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/

:

- Hide quoted text -
- Show quoted text -

 

[Michael Bauer]

Am 2 Jan 2006 21:07:18 -0800 schrieb Mick:

Probably you don´t have a folder named "Some Folder Under The Root". Simply
replace the sample string by an usefull folder name.

 

[Mick]

Sorry about that, I worded that wrong. I meant to say if I DONT have
the folder, I get the error that the folder doesn't exist.

As a matter of fact, I put a message line in places through the code to
make sure it was getting past the IF's and etc, and it definitely is
getting through the code properly, and for some reason the

objItem.Move objFolder

Simply isn't running. But, as I mentioned, I replace that code with a
simple

MsgBox "Test message"

I do get the message. Here's the actual code I have in the macro, and
as the original thread suggested, I do have a folder called Test, and
an email object in the inbox is selected. Oddly, I also used
objItem.forward to see if that would work, and I got nothing there. I
really don't know nearly enough to figure where this is going wrong.
Thanks much for your assistance!!

Mick


-----------
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("Test")
'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

 

[Michael Bauer]

Am 2 Jan 2006 23:19:19 -0800 schrieb Mick:

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

Actually that´s without any consequence, except the MsgBox. But you need to
ensure that the following lines won´t be executed if there´s no folder. That
is: insert e.g. an Exit Sub after the MsgBox.

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

- If you want to remove items from a list then then you need to loop
backwards.
- Because the folder won´t change within the loop, it isn´t necessary to
check the folder type again and again (but that´s no error if you´re doing
so).
- If you declare objItem As MailItem then it´s useless to check its type,
too. A MailItem object will never reference anything else as a MailItem.

If objFolder isn´t Nothing then this will work:

Dim i&, obj as Object, objItem as MailItem
If objFolder.DefaultItemType = olMailItem Then
For i=Application.ActiveExplorer.Selection.Count to 1 step -1
set obj=Application.ActiveExplorer.Selection(1)
If TypeOf obj is Outlook.MailItem then
Set objItem=obj
objItem.Move objFolder
Endif
Next
Endif

 

[Mick]

Great Thanks!!

Any input on how to assign the macro to a hotkey? I'm thinking a
[ctrl][shift]M or something...

Thanks again!

 

[Mick]

Actually, come to think of it, it would probably be better with a
[shift][del] or [ctrl][del] so they can delete or archive with minimal
difference... Thanks!!

 

[Michael Bauer]

Am 3 Jan 2006 15:39:08 -0800 schrieb Mick:

You can easily create a button via right click on the menu bar and
customize. Select the macro name and drag it onto the menu bar. Right click
on that new button, and you can e.g. edit the text. By a leading & you can
assign an accelerator.