Create Macro to move email to subfolder in inbox

15 Apr 2009 2:10 AM

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

15 Apr 2009 1:03 PM

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

Show quoteHide quote

"dza7" <dvpe***@gmail.com> wrote in message
news:b127a372-89eb-4f9c-8267-7a64df4002ed@w35g2000prg.googlegroups.com...
> 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

15 Apr 2009 3:08 PM

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

15 Apr 2009 3:40 PM

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

Show quoteHide quote

"dza7" <dvpe***@gmail.com> wrote in message
news:71eea014-09be-4887-8292-8be2f3d8d845@u9g2000pre.googlegroups.com...
> 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

15 Apr 2009 4:27 PM

dza7

Got it!

Thanks alot! This is going to help me out!

15 Apr 2009 5:48 PM

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

15 Apr 2009 10:48 PM

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

Show quoteHide quote

"dza7" <dvpe***@gmail.com> wrote in message
news:8ea9cf37-182c-42bf-99fa-014a50ba542e@w31g2000prd.googlegroups.com...
> 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

15 Apr 2009 11:35 PM

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!