Moving Mail

  • Thread starter Thread starter Nathan Carroll
  • Start date Start date
N

Nathan Carroll

why in procedure below do not all of the email messages get moved form the
loop process

Private Sub Application_Startup()
Dim item As Object
Dim subfolder As MAPIFolder
Dim mi As MailItem

On Error Resume Next
CreateButton

Set inBoxItems =
Me.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
For Each item In inBoxItems
If item.Class = olMail Then
Set mi = item
Set subfolder =
Me.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) _
.Folders(mi.SenderName)
If subfolder Is Nothing Then
Me.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) _
.Folders.Add (mi.SenderName)
Set subfolder =
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) _
.Folders(mi.SenderName)
End If
mi.Move subfolder
End If
Next

End Sub
 
Because the number of messages changes as you go through the loop.
Use something like
While inBoxItems.Count > 0
set mi = inBoxItems.Item(1)
...

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
 
thanks
Dmitry Streblechenko said:
Because the number of messages changes as you go through the loop.
Use something like
While inBoxItems.Count > 0
set mi = inBoxItems.Item(1)
...

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
Click to expand...
 
Ended up using a collection like so:
Seemed a bit faster.

Dim mailitems As Collection

Private Sub Application_Startup()
Dim item As Object
Dim subfolder As MAPIFolder
Dim mi As MailItem

'On Error Resume Next
CreateButton
Set mailitems = New Collection
Set inBoxItems =
Me.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items

For Each item In inBoxItems
If item.Class = olMail Then
Set mi = item
Set mIDs = New clsMailIds
mailitems.Add (mi.EntryID)
End If
Next


Dim o As Variant
Dim s As String

For Each o In mailitems
s = CStr(o)
Set mi = Me.GetNamespace("MAPI").GetItemFromID(s)

Set subfolder =
Me.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) _
.Folders(mi.SenderName)

If subfolder Is Nothing Then
Me.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) _
.Folders.Add (mi.SenderName)
Set subfolder =
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) _
.Folders(mi.SenderName)
End If

mi.Move subfolder

Next

Set subfolder = Nothing
Set mi = Nothing
Set mailitems = Nothing

End Sub
 
Back
Top