A (little messy) VBA-Script for Outlook to add Username to each Mail in Inbox.

SupplementMail.vba

Private WithEvents colItemsPersonal As Outlook.Items
Private WithEvents HotlineItems As Outlook.Items
Dim strUserField As String
Dim strPersonal As String
Dim strShared As String

'''Listen on two Mailboxes and supplement MailItem with senders Alias.
'''It's nice if you are using concern wide IDs (CWIDs) to identify your users.
Private Sub Application_Startup()
    
    strUserField = "samName"
    strPersonal = "dominique.clijsters@somedomain.com"
    strShared = "MyTicketSystem"
    
    Dim oApp As Outlook.Application
    Dim oNS As Outlook.NameSpace
    Dim objInbox As Outlook.MAPIFolder
    Dim objSharedInbox As Outlook.MAPIFolder
     
    Set oApp = Outlook.Application
    Set oNS = oApp.GetNamespace("MAPI")
      
    Set objInbox = oNS.Folders(strPersonal)
    Set colItemsPersonal = objInbox.Folders("Inbox").Items
      
    Set objSharedInbox = oNS.Folders(strShared)
    Set HotlineItems = objSharedInbox.Folders("Inbox").Items
      
End Sub

'Supplements MailItem with samName entry ("Alias", also known as samAccountName)
Sub SupplementItem(ByVal objMail As Object)
    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem

    If TypeName(objMail) = "MailItem" Then
        Set Msg = objMail
        Set objProperty = Msg.UserProperties.Add(strUserField, Outlook.OlUserPropertyType.olText)
        'Checks whether the sender of Msg is an Exchange compatible User. If True, use Alias property as samName
        If Msg.Sender.AddressEntryUserType = olExchangeUserAddressEntry Or _
            Msg.Sender.AddressEntryUserType = olExchangeRemoteUserAddressEntry Then
            ExUsr = Msg.Sender.GetExchangeUser()
            valueToSet = Msg.Sender.GetExchangeUser().Alias
            objProperty.Value = valueToSet
        Else
            'valueToSet = "External User / unresolvable"
        End If
        objProperty.Value = valueToSet
        Msg.Save
    End If
    
ProgramExit:
    Exit Sub
ErrorHandler:
    MsgBox "Fehler:" & vbCrLf & Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

'Occurs when a new Item is created in peronal Inbox
Private Sub colItemsPersonal_ItemAdd(ByVal objMail As Object)
    SupplementItem objMail
End Sub

'Occurs when a new Item is created in shared Inbox
Private Sub HotlineItems_ItemAdd(ByVal objMail As Object)
    SupplementItem objMail
End Sub