Private WithEvents SentItems As Items
 
' Class that runs at application start
 Private Sub Application_Startup()
    ' Declare certain necessary variables types
    Dim objNamespace As NameSpace
    Dim objRecipient As Recipient
    Dim objFolder As MAPIFolder
     
    ' define the namespace
    Set objNamespace = Me.GetNamespace("MAPI")
    ' Store the default user in a variable
    Set objRecipient = objNamespace.CreateRecipient(objNamespace.CurrentUser.Address)
    ' Resolve the recipient against the address book. True if found, false if failed
    objRecipient.Resolve
    ' Check if the recipient resolved
    If objRecipient.Resolved Then
        ' Person exists. Define the sent items
        Set SentItems = objNamespace.GetDefaultFolder(olFolderSentMail).Items
    Else
    ' Recipient did not resolve, thus we cannot find his mailbox
        MsgBox ("Fout! Kan je folder met verzonden items niet vinden." & vbNewLine & "Geen paniek! Maar vertel het toch maar tegen ICT.")
    End If
    
    Set objRecipient = Nothing
    Set objNamespace = Nothing
 End Sub
 
' Called when a new item is added to the sent items mailbox
Private Sub sentItems_ItemAdd(ByVal Item As Object)
    Dim strMailboxName As String
    Dim strFolderName As String
    Dim strTargetFolder As String
    Dim strSenderName As String
    Dim strSMTPAddress As String
    ' Emails received in the sent items folder sent by this email address will be moved.
    ' Not case sensitive, because we convert the emails to lowercase beforehand
    strSenderAddress = "sam@putte.be"
    ' If we can't find the email address, we can fall back on matching names.
    ' Not case sensitive since we convert the names to lowercase
    strSenderName = "Kristel Busschots"
    ' Name of the mailbox to which the mails should be moved.
    ' Case sensitive
    strMailboxName = "Kristel Busschots"
    ' Name of the folder to which we want to move the emails
        ' You can select the default sent items folder by using "objNamespace.GetDefaultFolder(olFolderSentMail)" (namespace is defined below)
        ' Though, this is not recommended because of Dutch/English localizations.
        ' Both mailboxes would need to use the same language, or else you'd try to find the "Sent Items" folder when the default one is "Verzonden Items"
    ' Case sensitive
    strTargetFolder = "Sent Items"
    
    ' Check if the item received is actually a mail item
    If (TypeOf Item Is Outlook.mailItem) Then
        Set objItem = Item
    Else
        MsgBox ("Item in mailbox is geen mail-item. U kan dit bericht negeren.")
    End If
    
    ' Navigate to the default inbox folder of the default mailbox
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
    
    ' Get the parent folder of the current mailbox, i.e. the mailbox folder
    strFolderName = objInbox.Parent
    ' Navigate to the mailbox with the corect name (strMailboxName variable)
    Set objMailbox = objNamespace.Folders(strMailboxName)
    ' Now that we found the mailbox, navigate to the correct folder (strTargetFolder variable)
    Set objFolder = objMailbox.Folders(strTargetFolder)
    ' If we're dealing with an exchange email, get try to figure out the actual email address instead of the exchange one
    If objItem.SenderEmailType = "EX" Then
        strSMTPAddress = getSMTPAddress(objItem.SenderEmailAddress)
    ' Else, just keep the actual email address
    Else
        strSMTPAddress = objItem.SenderEmailAddress
    End If
    ' Debug prints
    MsgBox "Sender name ----> " & objItem.SenderName
    MsgBox "objItem.SenderEmailAddress ----> " & objItem.SenderEmailAddress
    MsgBox "SMTP Address ----> " & strSMTPAddress
    
    ' Somehow the exchange email address came up blank when sending from a different account than the default one
    ' As a result, the SMTP address will be a blank string. If this is the case,
    ' We can still decide to move the email if the name is the one we need
    If strSMTPAddress <> "" Then
        ' Debug print
        MsgBox ("SMTP Address found, trying to match email ''" & strSMTPAddress & " '' with ''" & strSenderAddress & "''")
        ' Convert email addresses to lowercase and check if they're the same
        If LCase(strSMTPAddress) = LCase(strSenderAddress) Then
            objItem.Move objFolder
        End If
    Else
        ' Debug print
        MsgBox ("SMTP Address NOT found, trying to match name ''" & objItem.SenderName & " '' with ''" & strSenderName & "''")
        ' Convert names to lowercase and compare
        If LCase(objItem.SenderName) = LCase(strSenderName) Then
            objItem.Move objFolder
        End If
    End If
    Set objOutlook = Nothing
    Set objNamespace = Nothing
    Set objInbox = Nothing
    Set objMailbox = Nothing
    Set objFolder = Nothing
 End Sub

Public Function getSMTPAddress(ExchangeMailAddress As String) As String
    ' Initialize variables
    Dim objOutlook As Outlook.Application
    Dim objMailitem As Outlook.mailItem
    
    Set objOutlook = New Outlook.Application
    ' Create new email
    Set objMailitem = objOutlook.CreateItem(0)
    ' Set the sender address as the exchange email address we received as a parameter
    objMailitem.To = ExchangeMailAddress
    ' Try to resolve all recipients against the address book. Returns true if all objects were resolved, false otherwise
    If objMailitem.Recipients.ResolveAll Then
        getSMTPAddress = objMailitem.Recipients.Item(1).AddressEntry.GetExchangeUser.PrimarySmtpAddress
    Else
        MsgBox ("Opzoeking van afzender in adresboek mislukt")
        getSMTPAddress = ExchangeMailAddress
    End If
    
    ' Clear memory
    Set objMailitem = Nothing
    Set objOutlook = Nothing
End Function