VBA-Excel - per VBA per Excelmakro in Outlook Mails in einen Unterordner verschieben

Sub MailAnlagenSpeichern()
On Error GoTo Fehler_Outlook_Datenübernahme
    Dim fMails As Object, eMail As Object, objOL As Object
    Dim fErledigt As Object, Outlook_O As String, Outlook_UO As String
    Dim Anzahl_Email As Integer, Anzahl_Anhang As Integer
    Dim index_Email As Integer, index_Anhang As Integer
    Dim Dateipfad As String, Zähler_Anhang As Integer
    
    Zähler_Anhang = 1
  
    ' Outlook Object erzeugen  
    Set objOL = CreateObject("Outlook.Application")  
    
    ' Outlook-Ordner und Unterordner aus der Exceldatei auslesen  
    Outlook_O = Worksheets("Einstellungen").Cells(2, 3).Value  
    Outlook_UO = Worksheets("Einstellungen").Cells(2, 4).Value  
    
    'Dateiverzeichnis  
    Dateipfad = Worksheets("Einstellungen").Cells(2, 5).Value  
    
    ' prüfen wer das Programm ausführt. Information steht in "Blatt: Einstellungen Feld: A2" und die dazugehörige EMail-Adresse feststellen.  
    email_nr = Worksheets("Einstellungen").Cells(2, 1).Value  
    email_adresse = Worksheets("Einstellungen").Cells(4 + email_nr, 2).Value  
    
    'Ordner in Outlook referenzieren. EMail-Account muss passen und der EMailordner "0_Alerts" muss existieren. Inkl. dem Unterordner "erledigt"  
    Set fMails = objOL.Session.stores.Item(email_adresse).GetRootFolder.Folders.Item(Outlook_O)
    'Set objFolder = objOL.GetNamespace("MAPI").GetRootFolder.Folders.Item(Outlook_O)  
    
    ' Unterordner referenzieren in den die Mails verschoben werden wenn sie bearbeitet wurden. Muss existieren  
    Set fErledigt = fMails.Folders(Outlook_UO)
    
    'Das ist die Anzahl von emails im Ordner  
     Anzahl_Email = fMails.Items.Count
     MsgBox "Anzahl EMails: " & Anzahl_Email  
    
   
    'zählen der emails  
    If fMails.Items.Count > 0 Then

        For index_Email = 1 To Anzahl_Email 'Alle emails im Posteingang werden durchlaufen  
            Application.StatusBar = "Lese Posteingang " & _  
            Format(index_Email / Anzahl_Email, "0%") 'In der Statuszeile wird einiges angezeigt  
                With fMails.Items(index_Email) 'Durch diese WITH-Schleife kann die Nennung des Objekts  
                'bei den nächsten Befehlen entfallen  
                    If .Attachments.Count > 0 Then ' Anhänge abspeichern  
                        For index_Anhang = 1 To .Attachments.Count
                            Debug.Print strPath & .Attachments.Item(index_Anhang).Filename 'Ausgabe im Direktfenster! (Strg+G)  
                            .Attachments.Item(index_Anhang).SaveAsFile Dateipfad & Format(Now, "YYMMDD_HHMM") & "_" & Zähler_Anhang & "_" & .Attachments.Item(index_Anhang).Filename  
                        Next
                    End If
      
                End With
            Zähler_Anhang = Zähler_Anhang + 1 ' dient zur Namensgebung des Anhanges  
        Next
   
        'Verschieben der Mail in den "erledigt" Ordner  
        For Each eMail In fMails.Items
            eMail.Move fErledigt
            i = fMails.Items.Count 'nur zum Test eingebaut  
        Next
       
              
    Else
        MsgBox "Keine Mails zum Bearbeiten im Outlook-Ordner:  " & Outlook_O, vbExclamation  
    End If
    
    Set objOL = Nothing
    Set eMail = Nothing
    
'nur behandeln wenn Fehler, ansonsten keine MsgBox  
Exit Sub
Fehler_Outlook_Datenübernahme:
MsgBox ("Es ist ein Fehler im Programm aufgetreten! Bitte an den Entwickler wenden!" & vbCrLf & vbCrLf & "Fehlernummer: " & Err.Number & _  
        vbCrLf & "Fehlerbeschreibung: " & Err.Description)  
        
End Sub