CODEWITHSUNDEEP
outlook
T. Jones
T. Jones

Reputation: 13

Automatically moving email from Deleted Items folder to another folder

My company uses a cloud Exchange system that deletes emails when they have been in the Deleted Items folder for 30 days (we use Outlook 2010 clients). I want a script that would move all email from the Deleted Items folder to a second folder called "Trash". I was able to find most of the following script online but it isn't working for me and I'm not sure what is missing/incorrect. Any help is appreciated...

Sub MoveDeletedItems()
Dim oSource As Outlook.MAPIFolder
Dim oTarget As OutlookMAPIFolder
Dim oDummy As Object
Dim oToMove As Object
Dim colItems As Outlook.Items
Dim i As Long

Set oSource = Application.Session.GetDefaultFolder(olFolderDeletedItems)
Set oTarget = oSource.Folders.Folder("Trash")

Set colItems = oSource.Items

For i = colItems.Count To 1 Step -1
Set oToMove = colItems(i)
Set oDummy = oToMove.Move(oTarget)
Next
End Sub

Upvotes: 1

Views: 4730

Answers (1)

Sorceri
Sorceri

Reputation: 8033

Fist you have a lot of stuff going on you dont need

Here is an example with comments that can be run as a macro within outlook.

Sub MoveDeletedItems()
'setup some error checking
On Error GoTo err_rpt
Dim oSource As Outlook.MAPIFolder
Dim oTarget As Outlook.MAPIFolder
Dim oItem

'get the deleted Items folder
Set oSource = Application.Session.GetDefaultFolder(olFolderDeletedItems)
'get the folder under the Deleted Items folder called Trash
Set oTarget = oSource.Folders("Trash")
'loop through all the items in the source folder
For Each oMailItem In oSource.Items 
    'move the item to the target folder
    oItem.Move oTarget
Next

err_rpt:
If Err.Number > 0 Then
    MsgBox Err.Description
End If
'release the folders
Set oTarget = Nothing
Set oSource = Nothing
End Sub

Upvotes: 1

Related Questions