Move item marked to complete from all folder to specific folder

[cristianvacc]

Incoming mail is sorted in many folders with rules and vba script.
I want items marked to be completed to be moved.
I wrote the code. My code works.
The code does that all I want.
A code that is too complex. I think it must be shorter.
I have to enter up to 200 folders and in this way I have to do a very long code.
All messages in all incoming mail folders must be checked. All but 2 folders. The folders that do not need to be checked are called: "Da completare" and "Ritiri futuri".
I use Outlook 2016
Does anyone help me?
Thank you.


Sub MoveItems7TEST()


Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myInbox2 As Outlook.Folder
Dim myInbox3 As Outlook.Folder


Dim myDestFolder As Outlook.Folder


Dim myItems As Outlook.Items
Dim myItems2 As Outlook.Items
Dim myItems3 As Outlook.Items


Dim myItem As Object


Set myNameSpace = Application.GetNamespace("MAPI")
'Posta in arrivo
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
'Stef
Set myInbox2 = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("Stef")
'Servizio
Set myInbox3 = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("Servizio")


Set myItems = myInbox.Items
Set myItems2 = myInbox2.Items
Set myItems3 = myInbox3.Items


Set myDestFolder = myInbox.Folders("Da completare")


Set myItem = myItems.Find("[FLAGSTATUS] = 8")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend


Set myItem = myItems2.Find("[FLAGSTATUS] = 8")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems2.FindNext
Wend


Set myItem = myItems3.Find("[FLAGSTATUS] = 8")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems3.FindNext
Wend
End Sub

[skatonni]

Appears you want a recursive search so you do not have to list the folders. There are many code examples.

You may get all you need to know here http://www.vboffice.net/en/developer...nd-subfolders/

[cristianvacc]

Thank you very much. It's just what I'm looking for. I'm doing a lot of attempts, but I can not implement my code. Can you please help me?

[skatonni]

I changed variable names so they are differentiated a little. As well moving items is always a little more complex.

Sub MoveItems7TESTRecursive()
    
        Dim myNameSpace As Namespace
        Dim myInbox As Folder
        Dim myDestFolder As Folder
        
        Set myNameSpace = GetNamespace("MAPI")
        
        'Posta in arrivo
        Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
        
        Set myDestFolder = myInbox.Folders("Da completare")
        
        DoAnything myInbox, myDestFolder
    
        LoopFolders myInbox.Folders, myDestFolder, True
        
        Debug.Print "Done"
    
    End Sub
    
    Public Sub LoopFolders(fldrs As Folders, destFldr As Folder, ByVal Recursive As Boolean)
      
        Dim sourceFldr As Folder
        
        For Each sourceFldr In fldrs
            
            DoAnything sourceFldr, destFldr
    
            If Recursive Then
                LoopFolders sourceFldr.Folders, destFldr, Recursive
            End If
            
        Next
      
    End Sub
    
    Private Sub DoAnything(fldr As Folder, destFldr As Folder)
    
        Debug.Print fldr.name
        
        Dim myItem As Object
        Dim myItems As Items
        
        Set myItems = fldr.Items
        
        If fldr <> destFldr Then
            
            Set myItem = myItems.Find("[FLAGSTATUS] = 8")
            'Set myItem = myItems.Find("[Subject] = ""This is a test""")
            While TypeName(myItem) <> "Nothing"
                myItem.move destFldr
                Set myItem = myItems.FindNext
            Wend
    
        End If
        
    End Sub

[cristianvacc]

I have no words to say thank you. It works perfectly. I did not understand the structure. I did not understand the second part, but I only know that it works perfectly. Thanks thanks thanks. 1000 times thanks.

[cristianvacc]

skatonny please could you help me to exclude this folder:
myInbox.Folders("Ritiri futuri")

Your code is perfect, but I would like to exclude this folder: "Ritiri futuri"

[skatonni]

myDestFolder is being excluded. Set up say myExclFolder the same way

Set myExclFolder = myInbox.Folders("Ritiri futuri")

Then wherever you see myDestFolder add a myExclFolder. Where you see destFldr add a exclFldr.

In Sub DoAnything

 If fldr <> destFldr Then
        
    If fldr <> exclFldr Then
            
        Set myItem = myItems.Find("[FLAGSTATUS] = 8")

[cristianvacc]

Thanks for your help. Now works