title: For Each loop: Just deletes the very first attachment
body: <p>I've been trying to delete the attachments in Outlook after copying them using for each loop. It just deletes the very first attachment after copying it but does not go for the second attachment to work on! It just goes down to the End Sub.</p>
  
  <pre><code>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 &gt;= 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 &amp; Att
              olAttch.Delete
              End If
          Next olAttch
      Msg.UnRead = False
  
  End If
  
  ProgramExit:
    Exit Sub
  
  ErrorHandler:
    MsgBox Err.Number &amp; " - " &amp; Err.Description
    Resume ProgramExit
  End Sub
  </code></pre>
  
  <p>I figured out that the OlAttch.delete statement confuses the For Each loop.</p>
  
  <p>Any idea how I can delete the attachments.</p>