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/developers/looping-recursively-through-folders-and-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