move mail items to another folder?

  • Thread starter Thread starter Lux
  • Start date Start date
L

Lux

As above really, i want to be able to move all my inbox
items into another outlook folder..

any pointers?

i've tried the following, yes it works but only for one
person, i need to move them all..

i also need to schedule this, how do i schedule a macro to
run, say every 10 mins?

Public Sub MoveMessages()

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("Extracted Mail")
Set myItem = myItems.Find("[SenderName] = 'sendername'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend

End Sub


thanks in advance
 
Hi Lux,

Lux said:
As above really, i want to be able to move all my inbox
items into another outlook folder..

any pointers?

i've tried the following, yes it works but only for one
person, i need to move them all..

i also need to schedule this, how do i schedule a macro to
run, say every 10 mins?

Public Sub MoveMessages()

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("Extracted Mail")
Set myItem = myItems.Find("[SenderName] = 'sendername'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend

End Sub


thanks in advance
Click to expand...

Do While myItems.Count > 0
Set myItem = myItems(1)
myItem.Move myDestFolder
Loop

Regards, Werner
 
-----Original Message-----
As above really, i want to be able to move all my inbox
items into another outlook folder..

any pointers?

i've tried the following, yes it works but only for one
person, i need to move them all..

i also need to schedule this, how do i schedule a macro to
run, say every 10 mins?

Public Sub MoveMessages()

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("Extracted Mail")
Set myItem = myItems.Find("[SenderName] = 'sendername'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend

End Sub


thanks in advance
.
Click to expand...




Try this - it sorted through over 400 emails from 80+
senders in about 5 minutes. It is basically a wend loop
around your code. The problem you are having (in the
event you want to learn - the other post didn't mention
it) is that as soon as you move a mail item the rest of
the mail items in the inbox reenumerate themselves #2
becomes #1, etc. So, you basically pick up the sendername
off of the 1st email, make the folder, do your search and
move the found items to the folder and keep doing it until
your mail item count is zip.

Hope this helps

Public Sub MoveMessages()

Dim msg As MailItem


Set myNameSpace = ThisOutlookSession.Session

Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items


While myInbox.Items.Count > 0

Nm = myInbox.Items(1).SenderName


On Error Resume Next
myInbox.Folders.Add (Nm)

Continue:

Set myDestFolder = myInbox.Folders(Nm)
serchstrng = "[SenderName] = " & Chr(34) & Nm & Chr(34)
Debug.Print serchstrng

Set myItem = myItems.Find(serchstrng)


While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend

Wend

End Sub
 
Back
Top