Auto categorize duplicate subjects

Status
Not open for further replies.

codell911

Member
Outlook version
Email Account
Exchange Server
Currently using the following script to round robin assign incoming emails:

Dim i As Long
Private WithEvents olInboxItems As Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
Set olInboxItems = GetFolderPath("Mailbox - SATPD\Inbox").Items
Set objNS = Nothing
End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim strCat As String

On Error Resume Next

If Item.Class = olMail Then
Select Case i
Case 0
strCat = "Bob"
Case 1
strCat = "Larry"
Case 2
strCat = "Buddy"
Case 3
strCat = "Sue"

End Select

Item.Categories = strCat
Item.UnRead = True
Item.Save
Err.Clear
End If
i = i + 1
Debug.Print i
If i = 4 Then i = 0
End If

End Sub

Script works great! (thanks Diane)

What I want to add to it is add an IF condition where the script scans all incoming emails, and if it finds an incoming email with a subject that EXACTLY matches an email that has already been categorized to Bob, Larry, Buddy or Sue, categorize that new email to them as well. (i.e. if Bob has an email categorized to him with subject "Test 1234", then if a new emails comes in with subject "Test 1234", I would like that new email categorized to him and not be assigned "round robin".

Not to make it more complicated, but I also do want want that new email with the duplicate subject to count towards the "round robin". (i.e. email 1 goes to Bob, emails 2 comes in with a duplicate subject and goes to Larry who has an email with the same subject, if email 3 comes in without a duplicate subject, I want that to go to Larry as well since he is next in line for new emails after Bob)

Thanks for any help!
 
Correction to the last paragraph: I do NOT want that new email with the duplicate subject to count towards the "round robin"
 
I have a macro at Use a Rule to delete older messages as new ones arrive that deleted old mail of the same subject when a new message arrives... bits of that could be merged with this to do what you want.

This should do the look up and categories part - put it at the top and it exists if a match is found. If the inbox has a lot of mail, find or restrict would be faster though. (I use it on an inbox with over 4000 messages and it was slow until i restricted the count to the 30 most recent messages. 30 met my needs for the typical 4 hours between automated messages - i could go a little higher without slowing it down.)

If the messages will be replies, you need to account for the "RE: " - using the conversation topic instead of subject is one that should work - or you can use subject with the mid or instr function.

If objVariant.ConversationTopic= Item.ConversationTopic


Code:
For intCount = objInbox.Items.Count To 1 Step -1
Set objVariant = objInbox.Items.Item(intCount)
If objVariant.MessageClass = "IPM.Note" Then
    If objVariant.Subject = Item.Subject And objVariant.SentOn < Item.SentOn Then
     item.categories = objVariant.categories
     item.save
    exit sub
     Else
    End If
End If
Next

I don't think you need the date check - there will either be matches or not.
 
Not getting any errors, but after modifying the script, it isn't catching the duplicates:

Code:
Dim i As Long
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session
  Set olInboxItems = GetFolderPath("Mailbox - SATPD\Inbox").Items
Set objNS = Nothing
End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
    Dim strCat As String
  
    On Error Resume Next
  
    If TypeOf Item Is Outlook.MailItem Then
    DuplicateSubjects Item
    End If
  
    If Item.Class = olMail Then
  
    Select Case i
     Case 0
          strCat = "Bob"
     Case 1
          strCat = "Larry"
     Case 2
          strCat = "Buddy"
     Case 3
          strCat = "Sue"
              
    End Select


      
    Item.Categories = strCat
            Item.Save
        Err.Clear
     End If
     i = i + 1
     Debug.Print i
     If i = 4 Then i = 0
   
End Sub

Private Sub DuplicateSubjects(Item As Outlook.MailItem)

    Dim objInbox As Outlook.MAPIFolder
    Dim intCount As Integer
    Dim objVariant As Variant

Set objInbox = Session.GetDefaultFolder(olFolderInbox)

For intCount = objInbox.Items.Count To 1 Step -1
Set objVariant = objInbox.Items.Item(intCount)
If objVariant.MessageClass = "IPM.Note" Then
    If objVariant.Subject = Item.Subject And objVariant.SentOn < Item.SentOn Then
     Item.Categories = objVariant.Categories
     Item.Save
    Exit Sub
     Else
    End If
End If
Next

Set objInbox = Nothing
End Sub
 
To clarify, I want to use this on a shared mailbox as part of the application startup script to monitor emails as they come in.........................
 
I cannot copy lines on this tablet so i cant show you which line needs fixed, but if you are searching the same folder, you don't need to set a folder to search. You can use olinboxitems (which is set in startup) in place of objinbox.items.
 
Back on my desktop... this has the changes you need to make. This line: Set objInbox = Session.GetDefaultFolder(olFolderInbox) was looking in your own inbox.
Code:
Private Sub DuplicateSubjects(Item As Outlook.MailItem)

    Dim intCount As Integer
    Dim objVariant As Variant

For intCount = olInboxItems.Count To 1 Step -1
Set objVariant = olInboxItems.Item(intCount)
If objVariant.MessageClass = "IPM.Note" Then
    If objVariant.Subject = Item.Subject And objVariant.SentOn < Item.SentOn Then
     Item.Categories = objVariant.Categories
     Item.Save
    Exit Sub
     Else
    End If
End If
Next

Set objInbox = Nothing
End Sub
 
Awesome. Thank so much Diane!

Once more question ......on Outlook startup, is there anyway to use the GetFolderPath function to monitor 2 different shared mailboxes and use 2 different scripts for each? Basically, I want to use 1 script to monitor incoming to shared mailbox "Mailbox - Test1\Inbox" and then use a different script to monitor incoming to shared mailbox "Mailbox - Test2\Inbox". Is that possible?
 
Sure... you need to copy the relevant lines and use a different variable name - paste them right after the first one. The function is designed to work with any macro that calls it - i usually put it (and other functions) in a module named 'Functions' so i can easily see what i have available already.


Private WithEvents olInboxItems As Items
Private WithEvents olTest2InboxItems As Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
Set olInboxItems = GetFolderPath("Mailbox - SATPD\Inbox").Items
Set olTest2InboxItems = GetFolderPath("Mailbox - ABCDE\Inbox").Items

Set objNS = Nothing
End Sub

Add a second sub:
Private Sub olTest2InboxItems_ItemAdd(ByVal Item As Object)
'do whatever
end sub

If both subs are doing the same thing, you could share them - except in your specific case, the duplicates macro is checking a specific folder (olInboxItems) - you'd need to set a public variable and pass the folder name to it in the itemadd macro before handing it off. Easy to do, but something to keep in mind when sharing macros.

Private Sub olTest2InboxItems_ItemAdd(ByVal Item As Object)
SharedSub Item
end sub

Private SharedSub (Item As Object)
' do whatever
end if
 
Diane,

So basically, things are humming along nicely based on your last post. Only issue I see is, on the incoming mail count, its combing the 2 mailboxes into 1 count instead of counting them separately.

Example:

1st email comes into Mailbox 1 and is assigned to Bob (who is 1st in line in Mailbox 1)
2nd email comes into Mailbox 1 and is assigned to Bill (who is 2nd in line in Mailbox 1)
1st email comes into Mailbox 2 and is assigned to Sue (who is 3rd in line in Mailbox 2; it has skipped over Mary and Tim who are 1st and 2nd in line to receive new emails from this box) - I want this email going to the 1st person in line in Mailbox 2

Thoughts?
 
You need a second variable for the count -
Dim i As Long
Dim iA as long
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
P Email address auto-completes work fine on laptop, but no longer on desktop Using Outlook 2
C New pc, new outlook, is it possible to import auto-complete emailaddress Using Outlook 4
R Outlook 365 VBA AUTO SEND WITH DELAY FOR EACH EMAIL Outlook VBA and Custom Forms 0
Nufc1980 Outlook "Please treat this as private label" auto added to some emails - Help. Using Outlook 3
K vba code to auto download email into a specific folder in local hard disk as and when any new email arrives in Inbox/subfolder Outlook VBA and Custom Forms 0
F Auto changing email subject line in bulk Using Outlook 2
T Outlook 2019 Not Using Auto Compete After Deletion of 365 Using Outlook 1
richardwing Auto forward email that is moves into a specific outlook folder Outlook VBA and Custom Forms 5
D Auto Remove [EXTERNAL] from subject - Issue with Macro Using Outlook 21
nmanikrishnan Auto-reply from default account Using Outlook 1
A Imap account not auto syncing inbox at startup Using Outlook 0
K Run a script rule to auto 'send again' on undeliverable emails? Outlook VBA and Custom Forms 1
FryW Need help modifying a VBA script for in coming emails to auto set custom reminder time Outlook VBA and Custom Forms 0
S Auto forward for multiple emails Outlook VBA and Custom Forms 0
DDB VBA to Auto Insert Date and Time in the signature Outlook VBA and Custom Forms 2
V Auto-complete stopped working Using Outlook 4
D auto forward base on email address in body email Outlook VBA and Custom Forms 0
M Replyall macro with template and auto insert receptens Outlook VBA and Custom Forms 1
R Auto Forwarding with different "From" Outlook VBA and Custom Forms 0
P auto-complete is hopelessly broken Using Outlook 0
R Auto Assign Category colours to Incoming Emails based on whom the email is addressed Outlook VBA and Custom Forms 3
C Auto Run VBA Code on new email Outlook VBA and Custom Forms 1
S Outlook Macro to send auto acknowledge mail only to new mails received to a specific shared inbox Outlook VBA and Custom Forms 0
V Auto-Submitted: auto-replied in header Using Outlook 0
R Auto display of new email does not work on non-default account Outlook VBA and Custom Forms 0
B Outlook 2016 Auto-archive creates new folder Using Outlook 3
J Edit auto-complete list in Outlook 2016+/365? Using Outlook 0
P Auto assign shared mailbox Outlook VBA and Custom Forms 1
M Outlook 2010 Problem with OutLook 2010 32 bit, after Windows Auto Update Using Outlook 3
P [SOLVED] Auto remove [EXTERNAL] from subject Using Outlook 16
Z Add text to auto-forwarded e-mail Outlook VBA and Custom Forms 4
N Disable Auto Read Receipts sent after using Advanced Find Using Outlook 4
Q Prompt button to auto turn on Out of Office Outlook VBA and Custom Forms 3
P Auto Insert Current Date or Time into Email Subject Outlook VBA and Custom Forms 2
S Messages moved / deleted by auto-archive are not synchronized to exchange Exchange Server Administration 8
B Outlook 2010 is Auto Purging when not configured for that Using Outlook 1
M VBA to auto forward message with new subject and body text Outlook VBA and Custom Forms 8
A Auto Accept Meetings from the General Calendar Using Outlook 3
R auto send email when meeting closes from a shared calendar only Outlook VBA and Custom Forms 2
S auto-mapping mailboxes in outlook impacting an ost file? Exchange Server Administration 2
M Auto expand Distribution List Before Sending Email Outlook VBA and Custom Forms 1
M Auto-export mail to Excel Outlook VBA and Custom Forms 2
Ms_Cynic Auto-pasting email content in calendar appt? Using Outlook 2
R How Do I insert images in and Auto Reply Using Outlook 3
S Received mail as part of DL, need to auto-CC the same when replying Outlook VBA and Custom Forms 5
T Have Outlook 2016 suggest email address auto complete entries directly from the user's contacts list Using Outlook 10
T Have Outlook 2016 suggest email address auto complete entries directly from the user's contacts list Using Outlook 0
P Auto scroll to specific folder in Folder Pane Outlook VBA and Custom Forms 3
N Auto-complete - block select emails Using Outlook 3
C Auto save outlook attachments when email is received Outlook VBA and Custom Forms 1

Similar threads

Back
Top