Outlook rule to move sent items with Excel VBA - excel

Question

I have to sort about 8000 emails into the specific folders in Outlook (2013).
I created the folders in Outlook through an Excel list. This spreadsheet contains beside the foldername, as well the senders/receivers email address.
I want to create rules, following this example:
emails -> Received by sheet1.cells(i,4) -> move to folder =sheet1.cells(i,5)
Through googling I created this code:
Sub createOutlookRule()
Dim appOutlook As Outlook.Application
Dim olRules As Outlook.Rules
Dim myRule As Outlook.Rule
Dim moveToAction As Outlook.MoveOrCopyRuleAction
Dim fromAction As Outlook.ToOrFromRuleCondition
Dim myInbox As Outlook.Folder
Dim moveToFolder As Outlook.Folder
For i = 2 To 5
Set appOutlook = New Outlook.Application
Set myInbox = appOutlook.Session.GetDefaultFolder(olFolderInbox)
Set olRules = appOutlook.Session.DefaultStore.GetRules()
Set myRule = olRules.Create(Sheet2.Cells(i, 1), olRuleReceive)
Set fromAction = myRule.Conditions.From
a = Sheet2.Cells(i, 3)
Set moveToFolder = myInbox.Folders("Mifid").Folders(a)
With fromAction
.Enabled = True
If IsEmpty(Sheet2.Cells(i, 4)) Then GoTo 4 Else
.Recipients.Add (Sheet2.Cells(i, 4))
If IsEmpty(Sheet2.Cells(i, 5)) Then GoTo 3 Else
.Recipients.adds (Sheet2.Cells(i, 5))
3:
End With
Set moveToAction = myRule.Actions.moveToFolder
With moveToAction
.Enabled = True
.Folder = moveToFolder
End With
olRules.Save
4:
Next i
End Sub
This essentially creates the rule but so far does not move items.
I adjusted it for the sent-items but during the "move part" I get an error
Sub createOutlookRuleSENTITEMS()
Dim appOutlook As Outlook.Application
Dim olRules As Outlook.Rules
Dim myRule As Outlook.Rule
Dim moveToAction As Outlook.MoveOrCopyRuleAction
Dim SENTAction As Outlook.ToOrFromRuleCondition
Dim myInbox As Outlook.Folder
Dim moveToFolder As Outlook.Folder
For i = 2 To 5
Set appOutlook = New Outlook.Application
Set myInbox = appOutlook.Session.GetDefaultFolder(olFolderInbox)
Set olRules = appOutlook.Session.DefaultStore.GetRules()
Set myRuleSENT = olRules.Create(Sheet2.Cells(i, 1), olRuleSend)
Set TOAction = myRuleSENT.Conditions.SentTo
a = Sheet2.Cells(i, 3)
Set moveToFolder = myInbox.Folders("Mifid").Folders(a)
With TOAction
.Enabled = True
If IsEmpty(Sheet2.Cells(i, 4)) Then GoTo 4 Else
.Recipients.Add ("test#example.com")
If IsEmpty(Sheet2.Cells(i, 5)) Then GoTo 3 Else
.Recipients.adds (Sheet2.Cells(i, 5))
3:
End With
Set moveToAction = myRuleSENT.Actions.moveToFolder
With moveToAction
.Enabled = True
.Folder = moveToFolder
End With
olRules.Save
4:
Next i
End Sub
Error-Message:
Run-time error
Invalid operation. this rule action cannot be enabled because either the rule is read-only or invalid for the rule type, or the action conflicts with another action on the rule

Answer 1

The rules interface for sent items allows copy not move. (Does not prove it impossible.)
Option Explicit
Sub createOutlookRuleSENTITEMS()
' Reference Outlook nn.n Object Library
Dim appOutlook As Outlook.Application
Dim olRules As Outlook.Rules
Dim myRuleSENT As Outlook.Rule
Dim ToCondition As Outlook.ToOrFromRuleCondition
Dim CopySentItemRuleAction As Outlook.MoveOrCopyRuleAction
Dim myInbox As Outlook.Folder
Dim copyToFolder As Outlook.Folder
Dim i As Long
Set appOutlook = New Outlook.Application
Set myInbox = appOutlook.Session.GetDefaultFolder(olFolderInbox)
For i = 2 To 5
Set olRules = appOutlook.Session.DefaultStore.GetRules()
Debug.Print "Sheet2.Cells(i, 1): " & Sheet2.Cells(i, 1)
Set myRuleSENT = olRules.Create(Sheet2.Cells(i, 1), olRuleSend)
Set ToCondition = myRuleSENT.Conditions.SentTo
Dim a As String
a = Sheet2.Cells(i, 3)
Debug.Print "a: " & a
Set copyToFolder = myInbox.Folders("Mifid").Folders(a)
With ToCondition
.Enabled = True
Debug.Print "Sheet2.Cells(i, 4): " & Sheet2.Cells(i, 4)
If Not IsEmpty(Sheet2.Cells(i, 4)) Then
.Recipients.Add ("test#example.com")
If Not IsEmpty(Sheet2.Cells(i, 5)) Then
.Recipients.Add (Sheet2.Cells(i, 5))
End If
' The rules interface for sent items allows copy not move.
' (Does not prove it impossible.)
'
'Action is to copy, not move, the sent item
Dim oCopyTarget As Outlook.Folder
Set copyToFolder = myInbox.Folders("Mifid").Folders(a)
Set CopySentItemRuleAction = myRuleSENT.Actions.copyToFolder
With CopySentItemRuleAction
.Enabled = True
.Folder = copyToFolder
End With
olRules.Save
End If
End With
Next i
Debug.Print "Done."
End Sub