Option
Explicit
Sub
EmailAusAuswahlOrdnerVerschieben()
Dim
myExplorer
As
Outlook.Explorer
Dim
olApp
As
Object
Dim
myItems
As
Outlook.Items
Dim
myItem
As
Outlook.MailItem
Dim
olName
As
Outlook.
Namespace
Dim
CurrentFolder
As
Outlook.Folder
Dim
destFolder
As
Outlook.Folder
Dim
i
As
Integer
Dim
c
As
Integer
On
Error
Resume
Next
Set
olApp = CreateObject(
"Outlook.Application"
)
Set
olName = olApp.GetNamespace(
"MAPI"
)
Set
CurrentFolder = olApp.ActiveExplorer.CurrentFolder
Set
destFolder = olName.Session.Folders(
"xxx.xxx@xxx.com"
).Folders(
"Test"
)
Set
myItems = CurrentFolder.Items
For
i = myItems.count
To
1
Step
-1
Set
myItem = CurrentFolder.Items(i)
myItem.Move destFolder
Debug.Print myItem.
Class
Next
i
End
Sub