Consulting

Results 1 to 12 of 12

Thread: VBA script - Categorizing emails based on the subject

  1. #1
    VBAX Regular
    Joined
    Mar 2019
    Posts
    7
    Location

    Question VBA script - Categorizing emails based on the subject

    Hi Everyone,

    i am really new into VBA so I am sorry in advance if my questions are dumb

    I am trying to write script to have a macro button. The goal is that I want to select a bunch of email, click on the macro button to run the script and have these email assigned to a category (in the same Inbox folder) based on initials found in the subject.

    Here is my first attempt:

    Public Sub autocategories()

    If InStr(Email.Subject, "[CAT1]",vbTextCompare) > 0 Then
    Email.Categories = CAT1
    Email.Save
    ElseIf InStr(Email.Subject, "[CAT2]",vbTextCompare) > 0 Then
    Email.Categories = CAT2
    Email.Save
    ElseIf InStr(1, Email.Subject, "[CAT3]", vbTextCompare) > 0 Then
    Email.Categories = CAT3
    End If

    End Sub


    However, when i click on the macro button, Nothing happens...
    Can you please check this and let me know what I am doing wrong? Or is there any other way to have this function added?
    We used to work with Oulook rules, but we have so many that our Exchange server cannot handle them all...

    Many thanks in advance!

  2. #2
    The macro doesn't know what Email is. You need to tell it where to look.

    Public Sub autocategories()
    Dim olItem As Object
        For Each olItem In Application.ActiveExplorer.Selection
            If InStr(1, olItem.Subject, "[CAT1]", vbTextCompare) > 0 Then
                olItem.Categories = "CAT1"
            ElseIf InStr(1, olItem.Subject, "[CAT2]", vbTextCompare) > 0 Then
                olItem.Categories = "CAT2"
            ElseIf InStr(1, olItem.Subject, "[CAT3]", vbTextCompare) > 0 Then
                olItem.Categories = "CAT3"
            End If
             olItem.Save
           Next olItem
    Set olItem = Nothing
    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 Regular
    Joined
    Mar 2019
    Posts
    7
    Location
    I own you a beer this work perfectly!

    Now an additional question if I may.
    Is this possible to have this script running automatically for incoming emails?

  4. #4
    Duplicated
    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
    You could run the AutoCategorize macro below as a script from a rule that applies to all incoming messages, but as you said you were reluctant to use a rule, you could add the following to the ThisOutlookSession module

    Option Explicit
    
    Private WithEvents Items As Outlook.Items
    
    Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
        Set olApp = Outlook.Application
        Set objNS = olApp.GetNamespace("MAPI")
        Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
    lbl_Exit:
        Exit Sub
    End Sub
    
    Private Sub Items_ItemAdd(ByVal item As Object)
        On Error GoTo ErrorHandler
        If TypeName(item) = "MailItem" Then
            AutoCategorize item
        End If
    lbl_Exit:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Number & " - " & Err.Description
        Err.Clear
        GoTo lbl_Exit
    End Sub
    In a normal module enter the modified version of the code below, then restart Outlook (or manually run Application_Startup) to activate the event.
    Public Sub AutoCategorize(olItem As MailItem)
        With olItem
            If InStr(1, olItem.Subject, "[CAT1]", vbTextCompare) > 0 Then
                olItem.Categories = "CAT1"
                olItem.Save
            ElseIf InStr(1, olItem.Subject, "[CAT2]", vbTextCompare) > 0 Then
                olItem.Categories = "CAT2"
                olItem.Save
            ElseIf InStr(1, olItem.Subject, "[CAT3]", vbTextCompare) > 0 Then
                olItem.Categories = "CAT3"
                olItem.Save
            End If
        End With
    lbl_Exit:
        Exit Sub
    End Sub
    'Beers' can be delivered to my web site
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  6. #6
    VBAX Regular
    Joined
    Mar 2019
    Posts
    7
    Location
    So Sorry I couldn't answer before, I have been overloaded at work!

    I sent you a "beer" on your website.
    Not sure how much you receive usually so I really hope it's not too low

    Could you help me again please?
    I did try your method to have the script running automatically, but it doesn't seems to work.
    I sent a test email with the required initials in the subject but the email does not assign. Am I missing something? Ideally I'd like to have the same for the "Sent email", I guess same kind of script can be applied?

    Thanks again for your support on this, you're a huge help!

  7. #7
    Hard to say what the problem is, but the search is case sensitive so using the example the subject would have to contain e.g. [CAT1]

    If you make changes to the code, you would need to run Application_Startup again

    If you want to run the process on mails you send then in the ThisOutlookSession module add the following. This is a built-in event so doesn't rely on the Application_Startup macro to work.

    Private Sub Application_ItemSend(ByVal olItem As Object, Cancel As Boolean)
        With olItem
            If InStr(1, olItem.Subject, "[CAT1]", vbTextCompare) > 0 Then
                olItem.Categories = "CAT1"
                olItem.Save
            ElseIf InStr(1, olItem.Subject, "[CAT2]", vbTextCompare) > 0 Then
                olItem.Categories = "CAT2"
                olItem.Save
            ElseIf InStr(1, olItem.Subject, "[CAT3]", vbTextCompare) > 0 Then
                olItem.Categories = "CAT3"
                olItem.Save
            End If
        End With
    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

  8. #8
    VBAX Regular
    Joined
    Mar 2019
    Posts
    7
    Location
    Ok, for the sent item I could make it run automatically, I am starting to get the logic. Thanks for that!

    But for the emails received, I actually receive the following error when I restart outlook:

    "Compile error:
    Invalid attribute in Sub or Function"

    Also, the following part of the script is highlighted
    "...WithEvents Items As Outlook.Items"

    Any idea?

  9. #9
    VBAX Regular
    Joined
    Mar 2019
    Posts
    7
    Location
    and one last question (i Hope!)
    I could manage to point the macro to the item I wanted (subject, sender, body, ...) but is it possible to make it point to the file name of an attached email?
    i was expecting to have something like:

            ElseIf InStr(1, olItem.Attachemnts, "[CAT1]", vbTextCompare) > 0 Then
                olItem.Categories = "[CAT1]"
                olItem.Save
    But it doesn't seems to work and I couldn't find anything else on Google. Would you have any good address where to look that kind of stuff for my knowledge?

  10. #10
    Is the With Events line at the top of the ThisOutlookSession module (before the macros, but after Option Explicit if present)?

    e.g.
    Option Explicit
    
    Private WithEvents Items As Outlook.Items
    
    Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    'etc
    as for the attachments you will need to loop through the attachments collection e.g.
    For i = 1 To olItem.Attachments.Count
                If InStr(1, olItem.Attachments(i).fileName, "[CAT1]", vbTextCompare) > 0 Then
                    olItem.Categories = "CAT1"
                    olItem.Save
                    Exit For
                End If
            Next i
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    VBAX Regular
    Joined
    Mar 2019
    Posts
    7
    Location
    I copy pasted it at the top of the ThisOutlookSession.
    the error message is gone now, but it still doesn't run automatically...

    Regarding the attachement, this portion of code can be part of my main code?
    Like:

    Public Sub autocategories()
    Dim olItem As Object
        For Each olItem In Application.ActiveExplorer.Selection
            If InStr(1, olItem.Subject, "[cat1]", vbTextCompare) > 0 Then
                olItem.Categories = "CAT1"
            ElseIf InStr(1, olItem.Subject, "[cat2]", vbTextCompare) > 0 Then
                olItem.Categories = "CAT2"
    
    For i = 1 To olItem.Attachments.Count
                If InStr(1, olItem.Attachments(i).fileName, "[CAT1]", vbTextCompare) > 0 Then
                    olItem.Categories = "CAT1"
                    olItem.Save
                    Exit For
                End If
                Next i
             olItem.Save
           Next olItem
    Set olItem = Nothing
    End Sub
    Or should it be part of a different macro?

  12. #12
    VBAX Regular
    Joined
    Mar 2019
    Posts
    7
    Location
    hey, any feedback for me?

Posting Permissions

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