Log in
x
or
x
x
Register
x

or

unanswered Move item marked to complete from all folder to specific folder

  • cristianvacca@gmail.com
  • cristianvacca@gmail.com's Avatar Topic Author
  • Offline
More
1 year 3 months ago #1184 by cristianvacca@gmail.com
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: "" and "".
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

Please Log in or Create an account to join the conversation.

Moderators: jaychivoExcelfansqiuhongkun