Von Excel aus Dateienanhänge aus dem Outlook

Sub MailInfo()
    Dim fMails As Object, mail As Object, txtContent As String, arrContent As Variant, objExcel As Object, wb As Object, sheet As Object, rngStart As Object, rngCurrent As Object, objOL As Object, fErledigt As Object, colMove As New Collection, strSubject As String, mailItems As Object
strPath = Sheets("Start").Range("B3")  
Set olOrdner = GetObject("", "Outlook.Application").GetNamespace("MAPI").Folders("XXXXXXX").Folders("XXXXXXXXX").Folders("XXX")  
AnzahlEmail = olOrdner.items.Count

VonDatum = Format(Date - 1, "dd.mm.yy")  
BisDatum = Format(Date, "dd.mm.yy")  

While i < AnzahlEmail
    i = i + 1
On Error Resume Next
        With olOrdner.items(i)
            Received = Format(.ReceivedTime, "dd.mm.yy")  
                If VonDatum = Received Then
                        If .Attachments.Count > 0 Then
                              .Attachments.Item(1).SaveAsFile strPath & "ERR28_" & VonDatum & ".txt"  
                              .Attachments.Item(3).SaveAsFile strPath & "GESAMT28_" & VonDatum & ".txt"  
                              .Attachments.Item(6).SaveAsFile strPath & "REFANZ28_" & VonDatum & ".txt"  
                        End If
                 End If
                
                If BisDatum = Received Then
                        If .Attachments.Count > 0 Then
                              .Attachments.Item(1).SaveAsFile strPath & "ERR28_" & BisDatum & ".txt"  
                              .Attachments.Item(3).SaveAsFile strPath & "GESAMT28_" & BisDatum & ".txt"  
                              .Attachments.Item(6).SaveAsFile strPath & "REFANZ28_" & BisDatum & ".txt"  
                        End If
                 End If
        End With
    Set objOL = Nothing
    Set wb = Nothing
    Set sheet = Nothing
    Set mail = Nothing
    Set mailItems = Nothing
    Set colMail = Nothing
End Sub