Outlook Access VBA, Absender nicht erkannt

Option Compare Database
Option Explicit

Public Sub TestAccessDB_Outlook()


    Dim db As DAO.Database, rs As DAO.Recordset
    Dim objOutlook As Outlook.Application, objNameSpace As Outlook.NameSpace
    Dim objMailordner As Outlook.MAPIFolder
    Dim objGAINMailordner As Outlook.MAPIFolder
    Dim objAttachment As Outlook.Attachment, objMail As Outlook.Items
    Dim objEMail As Outlook.MailItem
    Dim intCtr As Integer
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT * FROM tbl_Email_Log;")  
    Set objOutlook = New Outlook.Application
    Set objNameSpace = objOutlook.GetNamespace("MAPI")  
    Set objMailordner = objNameSpace.GetDefaultFolder(olFolderInbox)
    Set objGAINMailordner = objMailordner.Folders("VBATest")  
    Set objMail = objGAINMailordner.Items
 
    For Each objEMail In objMail
        rs.AddNew
        rs.Fields("Betreff") = objEMail.Subject  
        rs.Fields("AnzAnhaenge") = objEMail.Attachments.Count  
        rs.Fields("EmailAn") = objEMail.ReceivedByName  
        rs.Fields("Erhalten") = objEMail.ReceivedTime  
        rs.Fields("EmailVon") = objEMail.ReplyRecipientNames  
        rs.Fields("EmailBCC") = objEMail.BCC  
        rs.Fields("EmailCC") = objEMail.CC  
        rs.Fields("EmailInhalt") = objEMail.Body  
        rs.Update
    Next objEMail
    
    For intCtr = 1 To objGAINMailordner.Items.Count
        For Each objAttachment In objGAINMailordner.Items(intCtr).Attachments
            objAttachment.SaveAsFile "C:\Users\user\Documents\" & objAttachment.FileName  
            
        Next objAttachment
    Next intCtr
    
    Forms!frm_Test.txt_Test = Forms!frm_Test.txt_Test & "Kein E-Mail" & vbNewLine  
        
    Set objAttachment = Nothing
    Set objMail = Nothing
    Set objMailordner = Nothing
    Set objGAINMailordner = Nothing
    Set objNameSpace = Nothing
    objOutlook.Quit
    Set objOutlook = Nothing

End Sub