VBA to Move (not Copy) Sent Items?

[Rhudi]

I have a feeling this isn't doable (nor is strictly a VBA question).

I have a rule that will "execute after send" anything that is sent to my cell phone's email (SMS).

The rule only has "Move a Copy", not "Move".

I have a folder under Sent Items that I want to hold only those emails. They are still technically under "Sent Items", just moved to a folder nested within.

I am hoping that threre may be a way to enhance this:

Sub RunToCellRule()
Dim st As Outlook.Store, myRules As Outlook.Rules, rl As Outlook.Rule, runrule$, rulename$

rulename = "To Cell"

Set st = Application.Session.DefaultStore

Set myRules = st.GetRules

For Each rl In myRules
    If rl.RuleType = olRuleSend Then
        If rl.Name = rulename Then
            rl.Execute ShowProgress:=True, Folder:=st.GetRootFolder.Folders("Sent Items"), IncludeSubfolders:=False, RuleExecuteOption:=olRuleExecuteAllMessages
            runrule = rl.Name
        End If
    End If
Next

rulename = "Rule executed: [" & runrule & "]"
MsgBox rulename, vbInformation, "Macro: RunToCellRule"

Set rl = Nothing
Set st = Nothing
Set myRules = Nothing
End Sub

If "Move" isn't an option, once a "Copy" is made, maybe "Delete" it from sent root folder?

[gmayor]

You could setup an event to process messages added to the sent items folder and if they meet the required criteria, move them to the named folder e.g. in the ThisOutlookSession module add the following code. Change someone@somewhere.com to the e-mail address you wish to process. Then either run the macro Application_Startup or restart Outlook to run it automatically. Send a message to that address and the message should be moved from the Sent folder to the named folder (here 'Forwarded' - which must exist)

Option Explicit

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    'default local Sent items
    Set Items = objNS.GetDefaultFolder(olFolderSentMail).Items
lbl_exit:
    Exit Sub
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)
Dim olFolder As Folder
Dim olMsg As MailItem
Const strSubFolder As String = "Forwarded" 'Change this line as appropriate
    On Error GoTo ErrorHandler
    If TypeName(item) = "MailItem" Then
        Set olFolder = Session.GetDefaultFolder(olFolderSentMail).folders(strSubFolder)
        Set olMsg = item
        If olMsg.Recipients(1).Address = "someone@somewhere.com" Then 'Change this line as appropriate
            olMsg.Move olFolder
        End If
    End If
lbl_exit:
    Set olMsg = Nothing
    Set olFolder = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Err.Clear
    GoTo lbl_exit
End Sub