Solved: Moving personal sent items to shared mailbox sent items

I have a team shared mailbox but we each have personal mailboxes when we sent items from the shared address the sent items appears in our personal sent items.

I came across the following code but cannot get it to work (attached)

I have added this in module1 to my outlook VB Editor. The top line 'Private WithEvents olkSentItems As Outlook.Items' is red and gives the error 'Only valid in object module'.

Any help is greatly appreciated.

Private WithEvents olkSentItems As Outlook.Items
 
Private Sub Application_Quit()
    Set olkSentItems = Nothing
End Sub
 
Private Sub Application_Startup()
    Set olkSentItems = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub
 
Private Sub olkSentItems_ItemAdd(ByVal Item As Object)
    Dim olkFolder As Outlook.MAPIFolder
    If Item.Class = olMail Then
        'Change the name on the following line as needed.  It will have to match the name in the message exactly.
        If Item.SenderName = "Selfcare Support" Then
            'Change the folder path on the following line to that of the folder you want the item moved to
            Set olkFolder = OpenOutlookFolder("Mailbox - Selfcare Support\Sent Items")
            Item.Move olkFolder
        End If
    End If
    Set olkFolder = Nothing
End Sub
 
Function IsNothing(obj)
  If TypeName(obj) = "Nothing" Then
    IsNothing = True
  Else
    IsNothing = False
  End If
End Function
 
Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        olkFolder As Outlook.MAPIFolder
    On Error GoTo ehOpenOutlookFolder
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        If Left(strFolderPath, 1) = "\" Then
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        End If
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            If IsNothing(olkFolder) Then
                Set olkFolder = Session.Folders(varFolder)
            Else
                Set olkFolder = olkFolder.Folders(varFolder)
            End If
        Next
        Set OpenOutlookFolder = olkFolder
    End If
    On Error GoTo 0
    Exit Function
ehOpenOutlookFolder:
    Set OpenOutlookFolder = Nothing
    On Error GoTo 0
End Function

Open in new window