Hallo zusammen!

Ich benutze Windows 11 und Office 365.

Der Makro siehe unten läuft ok - was nicht funktioniert ist, dass sich der Makro beendet mal bei 9 oder 4 oder 2 oder 3 Mails mit Anhängen.

Ich verstehe nicht warum er nicht ALLE Mails mit dem Anhang abarbeitet - ich muss den Makro deshalb immer wieder manuell starten.

Vielleicht hat jemand eine Lösung - Danke im Voraus.

Public Sub IPCam_original()
    Dim Foldername As String
    Dim objIn As MAPIFolder
    Dim objNewMail As MailItem
    Dim NumberOfMails, Z, i, s As Integer
    
    Z = 0
    On Error Resume Next
    Set objIn = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    For Each objNewMail In objIn.Items
        With objNewMail
        If objNewMail.SenderEmailAddress = "xxxxx@web.de" Then
            If .UnRead = True Then
                NumberOfMails = .Attachments.Count
                If NumberOfMails > 0 Then
                     Foldername = "D:\Temp\_reolink"
                     For i = 1 To NumberOfMails
                        .Attachments.Item(i).SaveAsFile (Foldername) & "\" & .Attachments.Item(i).FileName
                     Next i
                End If
            End If
            Z = Z + 1
            objNewMail.Delete
         End If
        End With
        'Debug.Print objNewMail.Subject
        'Debug.Print .Attachments.Count
    Next objNewMail
    MsgBox "Erledigt! " & Z      
End Sub