Consulting

Results 1 to 8 of 8

Thread: Move email to a folder based on some subject words

  1. #1
    VBAX Newbie
    Joined
    Sep 2018
    Posts
    4
    Location

    Move email to a folder based on some subject words

    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

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Newbie
    Joined
    Sep 2018
    Posts
    4
    Location
    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\

    Folders - Outlook.jpg

    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

  4. #4
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Newbie
    Joined
    Sep 2018
    Posts
    4
    Location
    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

  6. #6
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    VBAX Newbie
    Joined
    Sep 2018
    Posts
    4
    Location
    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

  8. #8
    That should work as long as you get the paths right.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •