0
Undo
Votes
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
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
- Page :
- 1
There are no replies made for this post yet.