• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 814
  • Last Modified:

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?
0
mjelec
Asked:
mjelec
  • 5
  • 5
1 Solution
 
Richard DanekeCommented:
Outlook is already an Access dataabase.   Wouldn't this process be better done in Outlook with Rules?
0
 
omgangCommented:
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
 
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
 [eBook] Windows Nano Server

Download this FREE eBook and learn all you need to get started with Windows Nano Server, including deployment options, remote management
and troubleshooting tips and tricks

 
mjelecAuthor Commented:
@omgang

I get a type mismatch on this line:

Set m = mf.Items.Restrict("[MessageClass]='IPM.Note'")
0
 
omgangCommented:
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
 
omgangCommented:
BTW - I'm running the function in Access 2007 against Outlook 2007.
OM Gang
0
 
omgangCommented:
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
 
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
 
omgangCommented:
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

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 5
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now