Emails to a distribution group aren't MailItems?

Question

I'm trying to write a VBA script for Outlook 2007 that moves a user's mail to an "Expired" folder if it's older than 89 days. I have code to do this, but it doesn't seem to work for aged emails that were to a distribution group that includes the end user. It works for emails just sent to the end user.

I combined code I found online for a) moving emails when they are a certain number of days old (http://www.slipstick.com/developer/macro-move-aged-mail/), and b) recursing through a folder to apply the code to subfolders as well (Can I iterate through all Outlook emails in a folder including sub-folders?). This code recurses through the Inbox folder and subfolders to move all aged mail.

It more or less works, but for some reason emails to a distribution list that includes the end user are not being picked up. The only remarkable check I have is that

    If TypeName(oItem) = "MailItem"

Are distribution list emails not considered MailItems? If not, how do I make sure to catch those too?

Here is the complete code:

    Public Sub MoveAgedMail(Item As Outlook.MailItem)

        Dim objOutlook As Outlook.Application
        Dim objNamespace As Outlook.NameSpace
        Dim objSourceFolder As Outlook.MAPIFolder
        Dim objVariant As Variant
        Dim lngMovedItems As Long
        Dim intCount As Integer
        Dim intDateDiff As Integer
        Dim strDestFolder As String
        Dim Folder As Outlook.MAPIFolder

        Dim oFolder As Outlook.MAPIFolder
        Dim oMail As Outlook.MailItem

        Set objOutlook = Application
        Set objNamespace = objOutlook.GetNamespace("MAPI")
        Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)

        ' Call processFolder
        processFolder objSourceFolder


    End Sub

    Public Sub processFolder(ByVal oParent As Outlook.MAPIFolder)

            Dim oFolder As Outlook.MAPIFolder
            Dim oMail As Outlook.MailItem
            Dim oItem As Object
            Dim intCount As Integer
            Dim intDateDiff As Long
            Dim objDestFolder As Outlook.MAPIFolder

        ' "Expired" folder at same level as Inbox for sending aged mail        
        Set objDestFolder = Session.GetDefaultFolder(olFolderInbox).Parent.Folders("Expired")

            For Each oItem In oParent.Items
                If TypeName(oItem) = "MailItem" Then
                    Set oMail = oItem

                    ' Check if email is older than 89 days
                    intDateDiff = DateDiff("d", oMail.SentOn, Now)


                    If intDateDiff > 89 Then

                   ' Move to "Expired" folder
                    oMail.Move objDestFolder

                    End If
                End If

            Next oItem

        ' Recurse through subfolders
            If (oParent.Folders.Count > 0) Then
                For Each oFolder In oParent.Folders
                    processFolder oFolder
                Next
            End If
            Set objDestFolder = Nothing
    End Sub

I think its batter to use For Loop With Step Backwards then using For Each when moving mailitems — 0m3r

Dmitry Streblechenko Dmitry Streblechenko · Accepted Answer · 2016-03-18T01:58:08

Firstly, do not use for each if you are modifying a collection - that will cause your code to skip half the items.

Secondly, do not just loop through all items in a folder, this is extremely inefficient. Use Items.Restrict or Items.Find/FindNext.

Try something like the following (VB script):

d = Now - 89
strFilter = "[SentOn]  < '" & Month(d) & "/" & Day(d) & "/" & Year(d) & "'"
set oItems = oParent.Items.Restrict(strFilter)
for i = oItems.Count to 1 step -1
  set oItem = oItems.Item(i)
  Debug.Print oItem.Subject & " " & oItem.SentOn
next

Emails to a distribution group aren't MailItems?

3 Answers