New to Outlook 2013, dealing with copying vs. moving sent items

[outlook2013]

New to Outlook 2013, first VBA code works, second one does not, can someone shed some light on this?

I am dealing with Moving Sent Items from Online Mailbox to PST\Sent Items:

Rule setup to “COPY” sent emails to BaseMailbox.pst\Sent Items

Inserted VBA code here to mark it as READ. This works fine but now I have the Sent Item in both Sent Items folders.

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
Set Items = GetFolderPath("BaseMailbox\Sent Items").Items

End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
Item.UnRead = False
Item.Save

End Sub

Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer

On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function


GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function

End Function

So I’d rather move the Sent Item from online mailbox to BaseMailbox.pst\Sent Items instead of Copy, mark unread

So I Disabled Copy Send Items rule and changed the VBA code to this:

I get an error on running it at Item.Move MovePst

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()

Set Items = Session.GetDefaultFolder(olFolderSentMail).Items

End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
Set MovePst = GetFolderPath("BaseMailbox\Sent Items")
Item.UnRead = False
Item.Move MovePst

End Sub

Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer

On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function


GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function

End Function