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: