Looping through items in a folder: random happenings

[Pog]

Hi,

When I run this macro, I expect it to check each email in folder "Batch Print" and move the email to another folder depending on whether: I) it has NO attachments, II) It has PDF only attachments, III) It has a mixture of attachments.

Two problems:

A) I have four test emails in the folder: "No Attachments", "PDF Only", "Excel Only", "Both Types". When I run the macro it only processed the last two. When I ran it again, it processed the first one only. Then I ran it a third time and it processed the second item. Why doesn't it process all four?

B) It thinks that the email with a PDF attachment has three other attachments (one .png and two .jpg's) - I cannot see these attachments! They are not visible! I didn't attach them. Likewise the one with no attachments, it thinks it has three (the same three as just stated)

Can you help please? In summary: Why doesn't the loop process ALL items in the folder? And where are these invisible attachments coming from??

Thanks.

Sub SortFolder()
    Dim olNs As Outlook.NameSpace
    Dim olMailFolder As Outlook.MAPIFolder
    Dim olItems As Outlook.Items
    Dim olMailItem As Outlook.MailItem
    Dim olAttach As Attachment
    Dim NonPDFFlag As Boolean
    
    On Error GoTo err_Handler
    Set olNs = GetNamespace("MAPI")
    Set myDestFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("For Investigation")
    Set NoAttachFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("No Attachments")
    Set PDFOnlyFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("PDF Only")
    Set olMailFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("Batch Prints")
    Set olItems = olMailFolder.Items
    
    For Each olMailItem In olItems
        If olMailItem.Attachments.Count > 0 Then
            For Each olAttach In olMailItem.Attachments
                If LCase(olAttach.FileName) Like "*.pdf" Then
                
                Else ' **
                    NonPDFFlag = True
                End If
            Next olAttach
            If NonPDFFlag = True Then ' **
                olMailItem.Move myDestFolder ' **   'For investigation
                NonPDFFlag = False ' **
            Else
                olMailItem.Move PDFOnlyFolder
            End If
        Else
            olMailItem.Move NoAttachFolder ' **
        End If
    
        DoEvents
    Next olMailItem
err_Handler:
    Set olNs = Nothing
    Set olMailFolder = Nothing
    Set olItems = Nothing
    Set olMailItem = Nothing
lbl_Exit:
    Exit Sub
End Sub

[gmayor]

Problem A
Declare all your variables - using Option Explicit will ensure that you do
Instead of using a For Each loop use

For lngCount = olItems.Count To 1 Step -1
        Set olMailItem = olItems(lngCount)

This will process the folder in reverse order and thus not screw up the count as items are removed.

Problem B
This is the bigger problem, because of the way attachments are identified in HTML e-mails which have graphic elements. Those graphics are classed as attachments. It can therefore be difficult to identify whether the attachments are required attachments or message images. I have not tested it, but I think the following may be closer to what you have in mind:

Option Explicit
Sub SortFolder()
Dim olNs As Outlook.NameSpace
Dim olMailFolder As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim noAttachFolder As Folder
Dim PDFOnlyFolder As Folder
Dim olItems As Outlook.Items
Dim olMailItem As Outlook.MailItem
Dim olAttach As Attachment
Dim bPDF As Boolean
Dim lngCount As Long
Dim lngAtt As Long

    On Error GoTo err_Handler
    Set olNs = GetNamespace("MAPI")
    Set myDestFolder = olNs.GetDefaultFolder(olFolderInbox).folders("For Investigation")
    Set noAttachFolder = olNs.GetDefaultFolder(olFolderInbox).folders("No Attachments")
    Set PDFOnlyFolder = olNs.GetDefaultFolder(olFolderInbox).folders("PDF Only")
    Set olMailFolder = olNs.GetDefaultFolder(olFolderInbox).folders("Batch Prints")
    Set olItems = olMailFolder.Items

    For lngCount = olItems.Count To 1 Step -1
        Set olMailItem = olItems(lngCount)
        bPDF = False
        If olMailItem.Attachments.Count > 0 Then
            For lngAtt = 1 To olMailItem.Attachments.Count
                If Right(LCase(olAttach.FileName), 4) = ".pdf" Then
                    bPDF = True
                    Exit For
                End If
            Next lngAtt
        Else
            olMailItem.Move noAttachFolder
        End If
        If bPDF = True Then
            olMailItem.Move PDFOnlyFolder
        Else
            olMailItem.Move myDestFolder
        End If
        DoEvents
    Next lngCount

err_Handler:
    Set olNs = Nothing
    Set olMailFolder = Nothing
    Set myDestFolder = Nothing
    Set noAttachFolder = Nothing
    Set PDFOnlyFolder = Nothing
    Set olItems = Nothing
    Set olMailItem = Nothing
lbl_Exit:
    Exit Sub
End Sub

[Pog]

That is very kind of you. I should have realised the cause of problem A - I'm going to blame my unfamiliarity with Outlook VBA for that. The code you have posted has given me a useful insight into the object model, and I am making my first tentative steps into the realm of Outlook programming. I am very grateful to you.

[Pog]

Yes, that worked, although I had to make a few corrections to the code as ol.Attach was undefined in your version after you replaced the For Each with For. This works:

Sub SortFolder()
    Dim olNs As Outlook.NameSpace
    Dim olMailFolder As Outlook.Folder
    Dim myDestFolder As Outlook.Folder
    Dim noAttachFolder As Folder
    Dim PDFOnlyFolder As Folder
    Dim olItems As Outlook.Items
    Dim olMailItem As Outlook.MailItem
    Dim olAttach As Attachment
    Dim bPDF As Boolean
    Dim lngCount As Long
    Dim lngAtt As Long
     
    'On Error GoTo err_Handler
    Set olNs = GetNamespace("MAPI")
    Set myDestFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("For Investigation")
    Set noAttachFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("No Attachments")
    Set PDFOnlyFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("PDF Only")
    Set olMailFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("Batch Prints")
    Set olItems = olMailFolder.Items
     
    For lngCount = olItems.Count To 1 Step -1
        Set olMailItem = olItems(lngCount)
        bPDF = False
        If olMailItem.Attachments.Count > 0 Then
            For Each olAttach In olMailItem.Attachments
                If Right(LCase(olAttach.FileName), 4) = ".pdf" Then
                    bPDF = True
                    Exit For
                End If
            Next
        Else
            olMailItem.Move noAttachFolder
        End If
        If bPDF = True Then
            olMailItem.Move PDFOnlyFolder
        Else
            olMailItem.Move myDestFolder
        End If
        DoEvents
    Next lngCount
     
err_Handler:
    Set olNs = Nothing
    Set olMailFolder = Nothing
    Set myDestFolder = Nothing
    Set noAttachFolder = Nothing
    Set PDFOnlyFolder = Nothing
    Set olItems = Nothing
    Set olMailItem = Nothing
lbl_Exit:
    Exit Sub
End Sub

You can take credit for giving me the confidence to find the error and being able to correct it. I'm on my way! Thanks.

[sosad]

because of the way attachments are identified in HTML e-mails which have graphic elements. Those graphics are classed as attachments. It can therefore be difficult to identify whether the attachments are required attachments or message images. I have not tested it, but I think the following may be closer to what you have in mind: