Move Inbox Subfolder Items by Category to Folder

**ker9** · 08-29-2011, 10:09 AM

Hi,
I would like to move items from the inbox to a different folder based on category. Because the category will be manually changed (to "done"), it won't be able to happen on send/receive.
I'm familiar with VBA in Excel but not in Outlook.

Any suggestions for how I might accomplish this? (Move from Florida inbox to Done inbox)

Thank you.
Karin
(Outlook 2010)

**ker9** · 08-29-2011, 01:10 PM

I've got this code, but it breaks on the line indicated

Sub MoveItems()

         Dim myOlApp As New Outlook.Application

         Dim myNameSpace As Outlook.NameSpace
         Set myNameSpace = myOlApp.GetNamespace("MAPI")
 
         Dim myBox As Outlook.MAPIFolder
         Set myBox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("!PS-In-Florida")

         Dim myDestFolder As Outlook.MAPIFolder
         Set myDestFolder = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("PS-Completed Items")

         Dim myItems As Outlook.Items
         Set myItems = myBox.Items
         
         Dim myItem As Object
'BREAKS ON NEXT LINE - not supported
         Set myItem = myItems.Categories = "@Done-Karin"

         While TypeName(myItem) <> "Nothing"

                 myItem.Move myDestFolder

                 Set myItem = myItems.FindNext

         Wend

End Sub

**ker9** · 08-29-2011, 02:43 PM

I've got this to work (am VERY excited!) - want to be able to find multiple categories, that is the next part of the puzzle.

Sub MoveDoneItems()

         Dim myOlApp As New Outlook.Application

         Dim myNameSpace As Outlook.NameSpace
         Set myNameSpace = myOlApp.GetNamespace("MAPI")
 
         'box to look at
         Dim myBox As Outlook.MAPIFolder
         Set myBox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("!PS-In-Florida")

         'box to move to
         Dim myDestFolder As Outlook.MAPIFolder
         Set myDestFolder = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("PS-Completed Items")

          Dim myItems As Outlook.Items
         Set myItems = myBox.Items
         
         Dim myItem As Object
         Set myItem = myItems.Find("[Categories] = @Done-Karin")
         
         While TypeName(myItem) <> "Nothing"
                 myItem.Move myDestFolder
                 Set myItem = myItems.FindNext
         Wend

End Sub

**ker9** · 08-29-2011, 05:13 PM

Well, I've spent the whole day on this, and while I did make great progress, it would seem that you cannot search a wildcard character on categories. So I'm thinking maybe do something like copy (through vba) the existing categories to some other field that I can search on. If anyone has ideas, I'd love some help.
Thanks!

**ker9** · 08-30-2011, 02:03 PM

With many, many thanks to:
Ken Slovak
MVP - Outlook
http://www.slovaktech.com
Author: Professional Programming Outlook 2007

Who responded to my plea for help in a different forum, below is the final result.

Sub MoveDoneItems2()

        Dim myOlApp As Outlook.Application
            Set myOlApp = Application

        Dim myNameSpace As Outlook.NameSpace
            Set myNameSpace = myOlApp.GetNamespace("MAPI")
 
        'box to look at
        Dim myBox As Outlook.MAPIFolder
            Set myBox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("@test")

        'box to move to
        Dim myDestFolder As Outlook.MAPIFolder
            Set myDestFolder = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("PS-Completed Items")

        Dim myItems As Outlook.Items
            Set myItems = myBox.Items
         
        Dim sFilter As String
            sFilter = "@SQL=" & Chr(34) & "urn:schemas-microsoft-com:office:office#Keywords" & Chr(34) & " LIKE '@Done%' "
         
        Dim myItem As Object
            Set myItem = myItems.Find(sFilter)
         
        While TypeName(myItem) <> "Nothing"
            myItem.Move myDestFolder
                Set myItem = myItems.FindNext
        Wend

End Sub