Delete Outlook Emails from MS Access

I'm using the below code to delete outlook items wit xlsx attachments. The issue encountered is that only some of the emails are deleted. Any thoughts

On Error GoTo SaveAttachmentsToFolder_err

    Dim ns As NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim Item As Object
    Dim Atmt As Outlook.Attachment
    Dim FileName As String
    
    Dim SubFolder As MAPIFolder
    
    
    
    
    Set ns = GetNamespace("MAPI")

    Set recip = ns.CreateRecipient("OMHA.HQ.MI.REPORTS")
   
    Set Inbox = ns.GetSharedDefaultFolder(recip, olFolderInbox)
    
    Set SubFolder = Inbox.Folders("MATS")


    If SubFolder.Items.Count = 0 Then
    
        MsgBox "There are no messages with attachments in the MATS folder.", vbInformation, _
                "Nothing Found"
        Exit Sub
    End If

    
    
    
    'Delete Outlook items
    For Each Item In SubFolder.Items
    For Each Atmt In Item.attachments
    If Atmt.Type = 1 And InStr(Atmt, "xlsx") > 0 Then
    Item.Delete
    End If
    Next Atmt
    Next Item
   
    
    
  
    
    ' Clear memory
SaveAttachmentsToFolder_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
' Handle Errors
SaveAttachmentsToFolder_err:
    MsgBox "An unexpected error has occurred." _
        & vbCrLf & "Please note and report the following information." _
        & vbCrLf & "Macro Name: GetAttachments" _
        & vbCrLf & "Error Number: " & Err.Number _
        & vbCrLf & "Error Description: " & Err.Description _
        , vbCritical, "Error!"
    Resume SaveAttachmentsToFolder_exit

Open in new window

shieldscoAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
While deleting items from a collection, you should loop in reverse order.
Replace lines#34:40 with the following lines and it would work as desired.

Dim i As Long
For i = SubFolder.items.Count To 1 Step -1
    Set Item = SubFolder.items(i)
    For Each Atmt In Item.attachments
        If Atmt.Type = 1 And InStr(Atmt, "xlsx") > 0 Then
            Item.Delete
            Exit For
        End If
    Next Atmt
Next i

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Jim Dettman (Microsoft MVP/ EE MVE)President / OwnerCommented:
This:

    For Each Item In SubFolder.Items
    For Each Atmt In Item.attachments
    If Atmt.Type = 1 And InStr(Atmt, "xlsx") > 0 Then
    Item.Delete
    End If
    Next Atmt
    Next Item

Open in new window


Doesn't seem right.....you should be setting a T/F flag for deleting the e-mail, not trying to delete it on every attachment check.   ie.:

 
    For Each Item In SubFolder.Items
    bolDeleteItem = False
    For Each Atmt In Item.attachments
      If Atmt.Type = 1 And InStr(Atmt, "xlsx") > 0 Then
        bolDeleteItem = True
      End If
    Next Atmt

    If bolDeleteItem = True then
     Item.Delete
    End If
    Next Item

Open in new window

0
shieldscoAuthor Commented:
Thanks Subodh
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.