Для каждого цикла: просто удаляет самое первое вложение

Я пытался удалить вложения в Outlook после копирования их, используя для каждого цикла. Он просто удаляет самое первое вложение после его копирования, но не работает для второго вложения! Это просто идет до конца Sub.

Private Sub Items_ItemAdd(ByVal item As Object)

    On Error GoTo ErrorHandler

    'Only act if it's a MailItem
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
        Set Msg = item

    'Change variables to match need. Comment or delete any part unnecessary.
        'If (Msg.SenderName = "Name Of Person") And _
        '(Msg.Subject = "Subject to Find") And _
        '(Msg.Attachments.Count >= 1) Then

    'Set folder to save in.
    Dim olDestFldr As Outlook.MAPIFolder
    Dim myAttachments As Outlook.Attachments
    Dim olAttch As Outlook.Attachment
    Dim Att As String

    'location to save in.  Can be root drive or mapped network drive.
    Const attPath As String = "C:\Users\pkshahbazi\Documents\EmailAttachments\"
    Set myAttachments = Msg.Attachments
        For Each olAttch In myAttachments
            Att = olAttch.DisplayName
            If Right(olAttch.FileName, 3) = "zip" Then
            olAttch.SaveAsFile attPath & Att
            olAttch.Delete
            End If
        Next olAttch
    Msg.UnRead = False

End If

ProgramExit:
  Exit Sub

ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

Я понял, что выражение OlAttch.delete сбивает с толку цикл For Each.

Любая идея, как я могу удалить вложения.

Ответы на вопрос(2)

Ваш ответ на вопрос