Problem mit SentOnBehalfOfName

Sub Auslesen()
' open the inbox
Dim ol As Outlook.Application
Dim ns As Namespace
Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Dim inbox As MAPIFolder
Set inbox = ns.Session.Folders("Name des Postfachs").Folders("Posteingang")
Dim outlook_item As Object
Dim Alias As String
For Each outlook_item In inbox.Items
' only look at emails
If outlook_item.Class = olMail Then
Alias = GetAlias(outlook_item, ns)
lz = Cells(65536, 1).End(xlUp).Row
For i = 2 To lz
If Range("A" & i) = Alias Then
Range("M" & i) = "ja"
If outlook_item.UnRead Then
outlook_item.UnRead = False
End If
End If
Next i
End If
Next outlook_item
End Sub

Function GetAlias(outlook_item As Outlook.MailItem, ns As Outlook.Namespace) As String
On Error GoTo err_handler
Dim email_address As String
Dim Alias as String
email_address = outlook_item.SentOnBehalfOfName
' if it's an Exchange format address
If UCase(outlook_item.SenderEmailType) = "EX" Then
' create a recipient
Dim recip As Outlook.Recipient
Set recip = ns.CreateRecipient(outlook_item.SentOnBehalfOfName)
' extract the Alias
Dim user As Outlook.ExchangeUser
Set user = recip.AddressEntry.GetExchangeUser()
Alias = user.Alias
GetAlias = Alias
Exit Function
Else
MsgBox "Für die private email-Absenderadresse " & email_address & " konnten keine Outlookdaten ermittelt werden."
End If
err_handler: MsgBox "Für " & email_address & " konnte kein Alias ermittelt werden"
End Function