AbsName = OutlAktMail.SenderName
ReceivedName = OutlAktMail.ReceivedByName
TX_Empfaenger.Value = Replace(OutlAktMail.Recipients.Item(1).Name, "'", "")

' Zugriff über MAPI 
Set objCDO = CreateObject("MAPI.Session")
objCDO.Logon "", "", False, False   ' Anmeldung
Set objMsg = objCDO.GetMessage(OutlAktMail.EntryID)
Set objSender = objMsg.Sender

'Absender Emailadresse ermitteln
Const g_PR_SMTP_ADDRESS_W = &H39FE001F

For Each objMsg In objCDO
Debug.Print objMsg.Subject
AbsName2 = objMsg.Sender.Address
      If Not InStr(strAddress, "@") Then
         On Error Resume Next
         AbsName2 = objMsg.Sender.Fields(g_PR_SMTP_ADDRESS_W).Value
      End If
Next

Option Explicit

Sub x()
   Dim objItem As MailItem
   Dim myRecipients As Recipients
   Dim myRecipient As Recipient
   
   If Not ActiveInspector Is Nothing Then
      If TypeOf ActiveInspector.CurrentItem Is MailItem Then
         Set objItem = ActiveInspector.CurrentItem
         Set myRecipients = objItem.Recipients
         myRecipients.ResolveAll
         For Each myRecipient In myRecipients
            Debug.Print myRecipient.Name, myRecipient.Address
         Next
      End If
   End If
End Sub