Filtering Mailitem and Contactitem

I am trying to build a program to take the items in an inbox move them to a working folder and process them into a database and move them to folders.  The issue arises with my code when another item other then a mailitem is introduced into the inbox.

my Original code was as follows:

Dim ol As New Outlook.Application
Dim olns As Outlook.NameSpace
Dim mf As Outlook.MAPIFolder
Dim destf As Outlook.MAPIFolder
Dim m As Outlook.MailItem
Dim objItems As Outlook.Items
Dim objItem As Object
Dim numitems As Integer
Dim i As Integer

Set olns = ol.GetNamespace("MAPI")
Set mf = olns.GetDefaultFolder(olFolderInbox).Folders("Test")
Set destf = olns.GetDefaultFolder(olFolderInbox).Folders("Test2")

numitems = mf.Items.Count

For i = numitems To 1 Step -1
    Set m = mf.Items.Item(i)
    m.Move destf
Next

I cant find a way to differentiate between items at least the code i found doesn't seem to work.

Here is my second try:

Set objItems = mf.Items

For Each objItem In objItems
Stop
    If (objItem.Class = olMailItem) Then
            Set m = mf.Items.Item(i)
            objItem.Move destf
    Else
            objItem.Delete
    End If
Next

This one doenst seem to work at all though.

any ideas?
mjelecAsked:
Who is Participating?
 
omgangIT ManagerCommented:
Well, I went back to your original solution to step through the items from the last to the first; this is necessary because the index of each item changes as items are removed from the folder.
This works
OM Gang

Public Function MoveInboxItems()
On Error GoTo Err_MoveInboxItems

    Dim ol As New Outlook.Application
    Dim olns As Outlook.NameSpace
    Dim mf As Outlook.MAPIFolder
    Dim destf As Outlook.MAPIFolder
    Dim m As Outlook.Items
    Dim objItem As Object
    Dim numitems As Integer
    Dim i As Integer

    Set olns = ol.GetNamespace("MAPI")
    Set mf = olns.GetDefaultFolder(olFolderInbox).Folders("Test")
    Set destf = olns.GetDefaultFolder(olFolderInbox).Folders("Test2")
   
    Set m = mf.Items.Restrict("[MessageClass]='IPM.Note'")
    numitems = m.Count
    For i = numitems To 1 Step -1
        Set objItem = m(i)
        objItem.Move destf
    Next i
   
Exit_MoveInboxItems:
    Set destf = Nothing
    Set objItem = Nothing
    Set m = Nothing
    Set mf = Nothing
    Set olns = Nothing
    Exit Function

Err_MoveInboxItems:
    MsgBox Err.Number & ", " & Err.Description, , "Error in Function MoveInboxItems of Module Module1"
    Resume Exit_MoveInboxItems
   
End Function
0
 
Richard DanekeTrainerCommented:
Outlook is already an Access dataabase.   Wouldn't this process be better done in Outlook with Rules?
0
 
omgangIT ManagerCommented:
Give this a shot.
OM Gang

Dim ol As New Outlook.Application
Dim olns As Outlook.NameSpace
Dim mf As Outlook.MAPIFolder
Dim destf As Outlook.MAPIFolder
'Dim m As Outlook.MailItem
Dim m As Outlook.Items
Dim objItems As Outlook.Items
Dim objItem As Object
Dim numitems As Integer
Dim i As Integer

Set olns = ol.GetNamespace("MAPI")
Set mf = olns.GetDefaultFolder(olFolderInbox).Folders("Test")
Set destf = olns.GetDefaultFolder(olFolderInbox).Folders("Test2")

numitems = mf.Items.Count

'For i = numitems To 1 Step -1
'    Set m = mf.Items.Item(i)
'    m.Move destf
'Next

Set m = mf.Items.Restrict("[MessageClass]='IPM.Note'")
For Each objItem in m
   m.Move destf
Next

0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
mjelecAuthor Commented:
@dodahd do you know what criteria for rules I need?  I can't seem to get it to work

@omgang I'll try that when I get the chance
0
 
mjelecAuthor Commented:
@omgang

I get a type mismatch on this line:

Set m = mf.Items.Restrict("[MessageClass]='IPM.Note'")
0
 
omgangIT ManagerCommented:
Needed to change the object.move statement.  Weird thing is each time I run this function it's only moving half the items in the Test folder.  Next time I run it it moves half again.  Weird.  I'll figure it out here in a minute (I hope).
OM Gang

Public Function MoveInboxItems()

On Error GoTo Err_MoveInboxItems

    Dim ol As New Outlook.Application
    Dim olns As Outlook.NameSpace
    Dim mf As Outlook.MAPIFolder
    Dim destf As Outlook.MAPIFolder
    'Dim m As Outlook.MailItem
    Dim m As Outlook.Items
    Dim objItems As Outlook.Items
    Dim objItem As Object
    Dim numitems As Integer
    Dim i As Integer

    Set olns = ol.GetNamespace("MAPI")
    Set mf = olns.GetDefaultFolder(olFolderInbox).Folders("Test")
    Set destf = olns.GetDefaultFolder(olFolderInbox).Folders("Test2")

    numitems = mf.Items.Count   '<--- don't really need this anymore

    'For i = numitems To 1 Step -1
    '    Set m = mf.Items.Item(i)
    '    m.Move destf
    'Next
   
    'For Each objItem In mf.Items        '<---- test to get message class of items in the folder
    '    Debug.Print objItem.MessageClass
    'Next
    'GoTo Exit_MoveInboxItems

    Set m = mf.Items.Restrict("[MessageClass]='IPM.Note'")
    'Debug.Print m.Count
    For Each objItem In m
    'm.Move destf                      '<---- here's what we needed to change to get the function to work
    objItem.Move destf
    Next
   

Exit_MoveInboxItems:
    Set destf = Nothing                   '<--- destroy object variables
    Set objItem = Nothing
    Set m = Nothing
    Set mf = Nothing
    Set olns = Nothing
    Exit Function

Err_MoveInboxItems:
    MsgBox Err.Number & ", " & Err.Description, , "Error in Function MoveInboxItems of Module Module1"
    Resume Exit_MoveInboxItems
   
End Function
0
 
omgangIT ManagerCommented:
BTW - I'm running the function in Access 2007 against Outlook 2007.
OM Gang
0
 
mjelecAuthor Commented:
Alright, that works, but there is a slight problem, it's a little too discriminate.

There are some mailitems that have different icons (I believe that is what the ipm.note is after) there are some items that are forwarded voicemail items that are being left behind.

other then that I think we are there.
0
 
omgangIT ManagerCommented:
Use something like this to identify the message class of those items that are being left behind
    'For Each objItem In mf.Items        '<---- test to get message class of items in the folder
    '    Debug.Print objItem.MessageClass
    'Next

And let me know.  I've got an idea about how to proceed.
OM Gang
0
 
mjelecAuthor Commented:
Actually for now I think we are there, I just spoke with the person who is running the process currently and only normal mail is being accepted currently.  If I need it differently Ill open a new question.
0
 
mjelecAuthor Commented:
Great help and an awesome job.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.