MAPI - problems with CopyTo and MoveTo 1

[Glasgow]

I've been having problems using the CopyTo and MoveTo methods available for mail items using CDO 1.21 library.

The error occurs in the LfnMove routine below. I am not sure how to code the MailItem.CopyTo or which ID property I may need to use - but every attempt just seems to spit back 'object does not support this property or method'.

I assume that I'm doing something really dumb!

Thanks in advance.





Private Sub CmdTest_Click()
Dim objOLApp As Object, objFolder As Object, objItem As Object
Dim OlMapi As Object, MstFolder As Object, SubFolder As Object
Set objOLApp = CreateObject("Outlook.Application&quot
Set OlMapi = objOLApp.GetNamespace("MAPI&quot
Set MstFolder = OlMapi.Folders("Phase 11 - 2004 Mail&quot
LfnSweepFolder MstFolder.Folders("InBox&quot, "Incoming"
LfnSweepFolder MstFolder.Folders("Sent Items&quot, "Outgoing"
End Sub

Private Sub LfnSweepFolder(Fldr As Object, MailTyp As String)
Dim MailItem As Object, Who As String
For Each MailItem In Fldr.items
Select Case LCase(TypeName(MailItem))
Case "mailitem"
With MailItem
Debug.Print "Folder: " & Fldr.Name
Debug.Print "To: " & .To
Debug.Print "From: " & .sendername
Debug.Print "Subject: " & .Subject
Debug.Print "Received: " & .ReceivedTime
Debug.Print "Will be moved to: " & LfnDestination(MailItem, MailTyp)
LfnMove MailItem, LfnDestination(MailItem, MailTyp), Fldr.Parent
End With
End Select
Next

Set MailItem = Nothing

End Sub
'**********************************************************
'* Deduce the logical destination folder for a mail item *
'* depending upon sender/recipient and/or subject *
'**********************************************************
Private Function LfnDestination(MailItem As Object, MailTyp As String) As String
Dim Where As String, Subject As String
If LCase(MailTyp) = "incoming" Then
Who = LCase(MailItem.sendername)
Else
Who = LCase(MailItem.To)
End If
Subject = LCase(MailItem.Subject)
Select Case True
Case InStr(Who, "fred&quot: Where = "Office"
Case InStr(Who, "john&quot: Where = "Admin"
etc
End Select
'Sender/recipient no good, try subject
If Where = "" Then
Select Case True
Case InStr(Subject, "sql server&quot: Where = "Microsoft"
Case InStr(Subject, "high st&quot: Where = "Office"
Case InStr(Subject, "zb360&quot: Where = "Junk"
End Select
If Where = "" Then Where = "**Unknown**"
End If
LfnDestination = Where
End Function

Private Sub LfnMove(MailItem As Object, Destn As String, ParentFldr As Object)
Dim ErrNo As Long, DestMsg As Object
On Error Resume Next
Set DestMsg = MailItem.CopyTo(ParentFldr.Folders(Destn).ID)
ErrNo = Err.Number
On Error GoTo 0
If ErrNo = -2147221233# Then 'folder does not exist
ParentFldr.Folders.Add Destn
Set DestMsg = MailItem.CopyTo(ParentFldr.Folders(Destn))
Else
Err.Raise ErrNo
End If
End Sub

 

[paulbent]

Your code uses the Outlook object model, not CDO 1.21! CopyTo and MoveTo are part of CDO. Equivalent Outlook method is:

Set DestFolder = ParentFldr.Folders(Destn)
Set DestMsg = MailItem.Copy
DestMsg.Move DestFolder


Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[Glasgow]

Shows how much I know about this - thanks Paul, that seems to work! Would you recommend using CDO 1.21 over the Outlook object model? If so, is there any example code that you could post that might kick me off in the right direction?

 

[paulbent]

>>Would you recommend using CDO 1.21 over the Outlook object model?<<

It's a question of choosing the right tool for the job. The CDO object model contains no user interface so if you want to display a folder in an Outlook Explorer or an item in an Outlook Inspector for example, CDO can't do it.

CDO and Outlook both provide access to MAPI message stores and contain methods to create, modify and delete folders and items. Outlook supports a wider range of item types. There are a few things you can only get from CDO (eg sender e-mail address from a mailitem) and vica versa.

Very often you need both libraries to get the job done. An Outlook folder or item object can't be passed directly to a CDO method and vica versa. The StoreID and EntryID properties are exposed by both libraries and can be used as parameters to return the same folder or item as an object of the other library.

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[Glasgow]

Thanks Paul - both your posts have been very helpful.

>There are a few things you can only get from CDO (eg sender e-mail address from a mailitem) and vica versa.

That was going to be the subject of my next post - i.e. where to get the email address! I don't need a user interface - this is a housekeeping/filing exercise to file incoming and outgoing email messages in 'appropriate' folders. Perhaps, therefore, I should be leaning towards CDO (dammit!).

 

[paulbent]

To be precise I should have said &quot;only get directly from CDO&quot;. In the case of sender e-mail address you can use Outlook and create a dummy reply then get the address from the first recipient object in the recipients collection.

Set objTmpItem = objMailItem.Reply
strSenderAddress = objTmpItem.Recipients(0).Address
Set objTmpItem = Nothing

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[Glasgow]

Thanks Paul - I've got the CDO approach virtually working. When looping through messages in a folder, the .CopyTo method works fine and makes a copy of every message but if I use .MoveTo I get a problem where some messages are apparently ignored. If I re-run the logic several times, the folder eventually clears - i.e. all messages are moved to required destinations.

It's as if the MoveTo method is somehow corrupting the Messages collection of the original folder such that it does not process all messages in the loop.

Any ideas?

Dim Msg As MAPI.Message
For Each Msg In Fldr.Messages
LfnMove Msg, LfnDestination(Msg, MailTyp), DstFldr
Next

Private Sub LfnMove(Msg As MAPI.Message, Destn As String, DstFldr As MAPI.Folder)
Dim NewMsg As MAPI.Message
If Not LfnFolderExists(Destn, DstFldr) Then
DstFldr.Folders.Add Destn
End If
Set NewMsg = Msg.MoveTo(DstFldr.Folders(Destn).ID)
' NewMsg.Update
End Sub

 

[paulbent]

The preferred way in CDO is to use the GetFirst and GetNext methods in a Do...Loop block. More reliable than For Each...Next. Another CDO concept is &quot;small&quot; and &quot;large&quot; collections. Messages is a large collection and as such its Count property is unreliable so you can't use a For...Next block either:

Dim objMsg As MAPI.Message
Dim objMsgs As MAPI.Messages

Set objMsgs = Fldr.Messages
Set objMsg = objMsgs.GetFirst
If Not objMsg Is Nothing Then
Do While Not objMsg Is Nothing
LfnMove objMsg, LfnDestination(objMsg, MailTyp), DstFldr
Set objMsg = objMsgs.GetNext
Loop
Else
'Folder is empty
End If


Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[Glasgow]

OK now I've learned something else (&quot;large&quot; collections)! Thanks again Paul, I'll give the GetFirst/GetNext approach a try.

 

[paulbent]

A large collection is a collection for which the service provider cannot maintain an accurate count of member objects and the Count property will not necessarilly return an accurate value. Large collections have Get methods to access individual objects.

A small collection is a collection for which the service provider maintains an accurate count of member objects. You can rely on the Count property and use an index number to access individual objects.

Small Collections:
AddressLists
Attachments
Columns
Fields
Formats
InfoStores
Patterns
Recipients
Views

Large Collections:
AddressEntries
Folders
Messages

Hope that helps; it's easy to be caught out if you don't know about CDO collection types!

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[Glasgow]

Thanks yet again. As I made painfully obvious from my naive, pathetic and embarrassing attempt to mix & match CDO 1.21 with Outlook object model, I am a CDO novice, so every little helps!

 

[paulbent]

>>I am a CDO novice<<

Every &quot;expert&quot; here was a novice at one time; it's nothing to be ashamed of! I make my living out of programming Outlook and Exchange Server and have several years experience - that's the only difference!

Good luck with your CDO project!

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[Glasgow]

Thanks Paul - I have noticed that you are often the first to pitch in on this subject matter.

I will soldier on and have CDO sussed by the time I'm 67. Climb every mountain, ford every stream, follow every rainbow.....

I really should have skipped The Sound of Music on TV this year.

 

[Glasgow]

Sorry to revive this but I am now experiencing problems with the GetNext method which does not appear to retrieve the next message. It all worked fine when I was unconditionally moving messages to a new destination folder but I now allow some messages to remain in the original folder. Whenever that happens, GetNext just sticks on the same record. Logic now is:

Private Sub LfnSweepFolder(Fldr As MAPI.Folder, MailTyp As String, DstFldr As MAPI.Folder)
Dim Msg As MAPI.Message, Where As String
Set Msg = Fldr.Messages.GetFirst
Do While Not Msg Is Nothing
Where = LfnDestination(Msg, MailTyp)
If Where <> &quot;&quot; Then LfnMove Msg, Where, DstFldr
Set Msg = Fldr.Messages.GetNext
Loop
End Sub


Any thoughts?

 

[paulbent]

I set up a test case but couldn't reproduce the problem. I created two subfolders under the Inbox, Source & Destination and conditionally moved some messages. All the correct ones were moved:

Option Explicit
Option Compare Text

Private Sub Command1_Click()

    Dim objSession As MAPI.Session
    Dim objInbox As MAPI.Folder
    Dim objSource As MAPI.Folder
    Dim objDest As MAPI.Folder
    Dim objMsgs As MAPI.Messages
    Dim objMsg As MAPI.Message
    Dim strFolderID As String
    
    Set objSession = CreateObject("MAPI.Session")
    objSession.Logon
    Set objInbox = objSession.Inbox
    Set objSource = objInbox.Folders("Source")
    Set objDest = objInbox.Folders("Destination")
    strFolderID = objDest.FolderID
    Set objMsgs = objSource.Messages
    Set objMsg = objMsgs.GetFirst
    If Not objMsg Is Nothing Then
        Do While Not objMsg Is Nothing
            If objMsg.Sender.Name = "Paul Bent" Then objMsg.MoveTo strFolderID, vbNullString
            Set objMsg = objMsgs.GetNext
        Loop
    Else
        MsgBox "Source folder is empty.", 16, "Folder Empty"
    End If
    
    Set objMsg = Nothing
    Set objMsgs = Nothing
    Set objDest = Nothing
    Set objSource = Nothing
    Set objInbox = Nothing
    Set objSession = Nothing
    
End Sub

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[Glasgow]

Thanks Paul. Once I changed the code to:

Private Sub LfnSweepFolder(Fldr As MAPI.Folder, MailTyp As String, DstFldr As MAPI.Folder)
Dim Msgs As MAPI.Messages, Msg As MAPI.Message, Where As String
Set Msgs = Fldr.Messages
Set Msg = Msgs.GetFirst
Do While Not Msg Is Nothing
Where = LfnDestination(Msg, MailTyp)
If Where <> &quot;&quot; Then LfnMove Msg, Where, DstFldr
Set Msg = Msgs.GetNext
Loop
End Sub

it started working OK - i.e. using the Msgs object rather than referencing Fldr.Messages explicitly. Not sure why that is? However problem resolved so thanks again.