Create Macro to move email to subfolder in inbox

[dza7]

Hello,

I'm attempting to create a macro in Outlook moving a message from my
inbox to a subfolder in my inbox, say for example this subfolder is
located in "Inbox/Test/Retail"

I found the code to move a message to "Inbox/Test" but I can't figure
out how to change the code so it can move the message to "Inbox/Test/
Retail".

Can someone help me move the message to a second layer of folders in
my inbox?

Here is the code I have now:

Sub move()

On Error Resume Next
Dim folder As Outlook.MAPIFolder, inboxFolder As
Outlook.MAPIFolder
Dim ns As Outlook.NameSpace, objItem As Outlook.MailItem
Set ns = Application.GetNamespace("MAPI")
Set inboxFolder = ns.GetDefaultFolder(olFolderInbox)
Set folder = inboxFolder.Folders("//inbox/test")

If Application.ActiveExplorer.Selection.Count = 0 Then
Exit Sub
End If

If folder Is Nothing Then
MsgBox "oops, no folder!", vbOKOnly + vbExclamation, "you're a
bad bad man"
End If

For Each objItem In Application.ActiveExplorer.Selection
If folder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.move folder
End If
End If
Next

Set objItem = Nothing
Set folder = Nothing
Set inboxFolder = Nothing
Set ns = Nothing

End Sub


Thanks,

Dza

[Ken Slovak - [MVP - Outlook]]

Set inboxFolder = ns.GetDefaultFolder(olFolderInbox)
Set folder = inboxFolder.Folders("test")
Set folder = folder.Folders("Retail")
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm

Post by dza7
Hello,
I'm attempting to create a macro in Outlook moving a message from my
inbox to a subfolder in my inbox, say for example this subfolder is
located in "Inbox/Test/Retail"
I found the code to move a message to "Inbox/Test" but I can't figure
out how to change the code so it can move the message to "Inbox/Test/
Retail".
Can someone help me move the message to a second layer of folders in
my inbox?
Sub move()
On Error Resume Next
Dim folder As Outlook.MAPIFolder, inboxFolder As
Outlook.MAPIFolder
Dim ns As Outlook.NameSpace, objItem As Outlook.MailItem
Set ns = Application.GetNamespace("MAPI")
Set inboxFolder = ns.GetDefaultFolder(olFolderInbox)
Set folder = inboxFolder.Folders("//inbox/test")
If Application.ActiveExplorer.Selection.Count = 0 Then
Exit Sub
End If
If folder Is Nothing Then
MsgBox "oops, no folder!", vbOKOnly + vbExclamation, "you're a
bad bad man"
End If
For Each objItem In Application.ActiveExplorer.Selection
If folder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.move folder
End If
End If
Next
Set objItem = Nothing
Set folder = Nothing
Set inboxFolder = Nothing
Set ns = Nothing
End Sub
Thanks,
Dza

[dza7]

excellent!

Thank you.

Just in case it comes up, what would the code be for moving a message
to a third level of folders say "Inbox/Test/Retail/Shipment"

Thanks,

Daniel

[Ken Slovak - [MVP - Outlook]]

Set folder = folder.Folders("Retail")
Set folder = folder.Folders("Shipment")

See a pattern there?
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm

Post by dza7
excellent!
Thank you.
Just in case it comes up, what would the code be for moving a message
to a third level of folders say "Inbox/Test/Retail/Shipment"
Thanks,
Daniel

[dza7]

Got it!

Thanks alot! This is going to help me out!

[dza7]

Sorry, one more thing!

How about assigning a keyboard shortcut to these marcos. For
instances, I'd like to maybe change the code so that the following
macro can happen when I hit the number "0" on my keyboard


Sub VENT()

On Error Resume Next
Dim folder As Outlook.MAPIFolder, inboxFolder As
Outlook.MAPIFolder
Dim ns As Outlook.NameSpace, objItem As Outlook.MailItem
Set ns = Application.GetNamespace("MAPI")
Set inboxFolder = ns.GetDefaultFolder(olFolderInbox)

Set folder = inboxFolder.Folders("Retail")
Set folder = folder.Folders("Stores")
Set folder = folder.Folders("0-Ventura")


If Application.ActiveExplorer.Selection.Count = 0 Then
Exit Sub
End If

If folder Is Nothing Then
MsgBox "oops, no folder!", vbOKOnly + vbExclamation, "you're a
bad bad man"
End If

For Each objItem In Application.ActiveExplorer.Selection
If folder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.move folder
End If
End If
Next

Set objItem = Nothing
Set folder = Nothing
Set inboxFolder = Nothing
Set ns = Nothing

End Sub

[Ken Slovak - [MVP - Outlook]]

Not possible.

You can add a button to a toolbar to call the macro.

Make sure it's a Public Sub with no input arguments. Right-click on the
Outlook menu bar, select Customize. Commands tab, select Macros in the
left-hand listbox. Select the macro and drag it to where you want it. You
can right-click that button to rename it.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm

Post by dza7
Sorry, one more thing!
How about assigning a keyboard shortcut to these marcos. For
instances, I'd like to maybe change the code so that the following
macro can happen when I hit the number "0" on my keyboard
Sub VENT()
On Error Resume Next
Dim folder As Outlook.MAPIFolder, inboxFolder As
Outlook.MAPIFolder
Dim ns As Outlook.NameSpace, objItem As Outlook.MailItem
Set ns = Application.GetNamespace("MAPI")
Set inboxFolder = ns.GetDefaultFolder(olFolderInbox)
Set folder = inboxFolder.Folders("Retail")
Set folder = folder.Folders("Stores")
Set folder = folder.Folders("0-Ventura")
If Application.ActiveExplorer.Selection.Count = 0 Then
Exit Sub
End If
If folder Is Nothing Then
MsgBox "oops, no folder!", vbOKOnly + vbExclamation, "you're a
bad bad man"
End If
For Each objItem In Application.ActiveExplorer.Selection
If folder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.move folder
End If
End If
Next
Set objItem = Nothing
Set folder = Nothing
Set inboxFolder = Nothing
Set ns = Nothing
End Sub

[dza7]

OK thanks, I've already set up buttons for each of the macros and they
are working great, just trying to see if there was an even quicker way!