Move email to a folder based on some subject words

[LBarroso]

Hi,
It's my first post in this group. this means I'm newest in VBA programming.

I want one macro for Outlook that moves one email from inbox to one inbox subfolder based in some subject words.

I do the following code that I think work, but I don't know how to call the procedure "Move Mail"

/vba
Sub MoveMail(Item As Outlook.MailItem)
With Item
If InStr(1, .Subject, "SVR") > 0 And InStr(1, .Subject, "HS") > 0 Then
Item.Move Session.GetDefaultFolder(olFolderInbox).Folders("HS HK")
End If
End With
End Sub
/vba

Please anyone can help me?

Thanks in advance.

Luis

[gmayor]

You could run it as a script from a rule, or you can select a message and run the following macro to call your macro.

Sub GetMsg()
Dim olMsg As MailItem
On Error Resume Next
Set olMsg = ActiveExplorer.Selection.item(1)
MoveMail olMsg
lbl_Exit:
Exit Sub
End Sub

[LBarroso]

gmayor,

Thank you for such a quick response.

Well, don't work because I don't know how to call the subfolder of the inbox. inbox\1-SVR\HS HK\

22918

Can you tell me how to do this? And it's possible the macro search for Unread emails in the inbox folder and checks the subject?
BVA with Excel I know something, with Outlook I don't know anything, I need to learning. Sorry for bored you.
Thanks in advance.

Luis

[gmayor]

The path in your code does not match the path in your illustration, so it isn't going to work. Change the main macro to the following which does match the path.


Sub MoveMail(Item As Outlook.MailItem)
Dim olFolder As Folder
Set olFolder = Session.GetDefaultFolder(olFolderInbox).folders("1-SVR").folders("HS-HK")
With Item
If InStr(1, .Subject, "SVR") > 0 And InStr(1, .Subject, "HS") > 0 Then
Item.Move olFolder
End If
End With
Set olFolder = Nothing
End Sub

If you want to process the inbox, you need a macro that will loop through the contents of that folder and check for unread messages e.g.


Sub ProcessFolder()
'Graham Mayor - http://www.gmayor.com - Last updated - 24 Sep 2018
Dim olNS As Outlook.NameSpace
Dim olMailFolder As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim olMailItem As Outlook.MailItem
Dim i As Long

On Error GoTo Err_Handler
Set olNS = GetNamespace("MAPI")
Set olMailFolder = olNS.GetDefaultFolder(olFolderInbox)
Set olItems = olMailFolder.Items
For Each olMailItem In olItems
If olMailItem.UnRead = True Then
MoveMail olMailItem
DoEvents
End If
Next olMailItem
lbl_Exit:
Set olNS = Nothing
Set olMailFolder = Nothing
Set olItems = Nothing
Set olMailItem = Nothing
Exit Sub
Err_Handler:
Err.Clear: GoTo lbl_Exit
End Sub

[LBarroso]

gmayor thanks for your code.
But do nothing because don't find unread emails.

I change the code with some counters "n" and "m" like you can see in the part of your code to check the number of items.


Dim i As Long
n = 0
m = 0
On Error GoTo Err_Handler
Set olNS = GetNamespace("MAPI")
Set olMailFolder = olNS.GetDefaultFolder(olFolderInbox)
Set olItems = olMailFolder.Items
For Each olMailItem In olItems
n = n + 1
If olMailItem.UnRead = True Then
m = m + 1
MoveMail olMailItem
DoEvents
End If
Next olMailItem
lbl_Exit:
Set olNS = Nothing
Set olMailFolder = Nothing
Set olItems = Nothing
Set olMailItem = Nothing
Debug.Print n
Debug.Print m
Exit Sub
Err_Handler:

And the results are n=179 and m=0

If I'm correct the "n" must be greater then 1000, because I have more than 1000 emails in my inbox folder and "n" must be 80, because as you can see in the previous image I have 80 unread email's in the inbox folder.

What going wrong?

Thanks for your patience with me.

Luis

[gmayor]

Counting when using loops tends to go awry when items are removed from the collection, so it is better to loop in reverse.
See if you fare any better with


Sub Macro1()
Dim olNS As NameSpace
Dim olMailFolder As Folder
Dim olItems As Items
Dim olMailItem As Object

Dim i As Long, n As Long, m As Long
n = 0
m = 0
On Error GoTo Err_Handler
Set olNS = GetNamespace("MAPI")
Set olMailFolder = olNS.GetDefaultFolder(olFolderInbox)
Set olItems = olMailFolder.Items
For i = olItems.Count To 1 Step -1
Set olMailItem = olItems(i)
n = n + 1
If olMailItem.UnRead = True Then
m = m + 1
MoveMail olMailItem
DoEvents
End If
Next i
lbl_Exit:
Set olNS = Nothing
Set olMailFolder = Nothing
Set olItems = Nothing
Set olMailItem = Nothing
Debug.Print n
Debug.Print m
Exit Sub
Err_Handler:
Err.Clear
GoTo lbl_Exit
End Sub

[LBarroso]

gmayor,

Now it´s ok and work very well. Many thanks. :)

Now I will try to make the code to move to the correct folders and subfolders that I have in 0-DR and 1-SVR.
I´m thinking to use the "Select Case" to check the subject string and then assign to the "olFolder" the correspondent folder and subfolder.

If I can not do that, I'll ask you for help again.
Many thanks for your important help and patience with me.
Luis

[gmayor]

That should work as long as you get the paths right.