CODEWITHSUNDEEP
vbaoutlook
rocky09
rocky09

Reputation: 113

Loop changes category on first instance only

I have 100s of emails to check for a string. If the string appears in the email, categorize as "Ticketed" else "NOTTICKETED".

The code is working for the first email and not for the rest of the emails.

Sub Find_String()
    Dim olApp As Outlook.Application
    Dim olExp As Outlook.Explorer
    Dim olFolder As Outlook.MAPIFolder
    Dim obj As Object
    Dim i As Long
    Dim x As Long
    Dim count As Long
    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    
    Set olApp = Outlook.Application
    Set olExp = olApp.ActiveExplorer
    Dim olMatches As Object
    Set olFolder = olExp.CurrentFolder
    
    'Set count of email objects
    count = olFolder.Items.count
    
    'counter for emails
    x = 1
    
    regEx.Pattern = "(Consumer Number:.*\d{5})"
    regEx.IgnoreCase = True
    regEx.MultiLine = True
    regEx.Global = True
    Set olMatches = regEx.Execute(stremBody)
    
    For Each obj In olFolder.Items
    
        If regEx.test(obj.Body) Then
            obj.Categories = "TICKETED"
        Else
            obj.Categories = "NO TICKET"
        End If
        x = x + 1
    
    Next obj
    
    MsgBox ("All Emails checked")
ExitProc:
    Set emItm = Nothing
    Set olFolder = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
End Sub

Upvotes: 0

Views: 70

Answers (1)

Dmitry Streblechenko
Dmitry Streblechenko

Reputation: 66215

You need to save the message after setting the category:

If regEx.test(obj.Body) Then
    obj.Categories = "TICKETED"
Else
    obj.Categories = "NO TICKET"
End If
obj.Save

Upvotes: 1

Related Questions