Search code examples
vbaoutlookpseudocode

VBA-sort through mailbox and move duplicate subjects to folder


I've run into an issue where i'm writing a macro in Outlook 2013 that goes through an inbox and whenever it comes across duplicate subject lines it moves the 2 emails to a different folder.

These "duplicates" have slight differences within the subject line, difference being a "new" prefix and a "closed" prefix.

I have a general idea on how I can achieve this, but i'm sure there would be a much cleaner and more efficient way to do so as there are 50 different subject lines (without prefix included) .

Currently my thoughts is to have something similar to below:

for i = 1 to inbox.items.count 
    if inbox.items(i) = "new - example subject 1" then
        for x = 1 to inbox.items.count
            if inbox.items(x) = "closed - example subject 1" then
                inbox.items(x).unread = false
                inbox.items(x).move otherFolder
                inbox.items(i).unread = false
                inbox.items(i).move otherFolder
                exit for
            end if
        next x
     end if


    if inbox.items(i) = "new - example subject 2" then
        for x = 1 to inbox.items.count
            if inbox.items(x) = "closed - example subject 2" then
                inbox.items(x).unread = false
                inbox.items(x).move otherFolder
                inbox.items(i).unread = false
                inbox.items(i).move otherFolder
                exit for
            end if
        next x
     end if


'repeating 50 times'


next i

Solution

  • You need to use the Find/FindNext or Restrict methods of the Items class instead of iterating through all items in the folder. For example:

    Sub DemoFindNext() 
     Dim myNameSpace As Outlook.NameSpace 
     Dim tdystart As Date 
     Dim tdyend As Date 
     Dim myAppointments As Outlook.Items 
     Dim currentAppointment As Outlook.AppointmentItem 
    
     Set myNameSpace = Application.GetNamespace("MAPI") 
     tdystart = VBA.Format(Now, "Short Date") 
     tdyend = VBA.Format(Now + 1, "Short Date") 
     Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items 
     Set currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """") 
     While TypeName(currentAppointment) <> "Nothing" 
       MsgBox currentAppointment.Subject 
       Set currentAppointment = myAppointments.FindNext 
     Wend 
    End Sub
    

    See the following articles for more information and sample code:

    Also you may find the AdvancedSearch method of the Application class helpful. The key benefits of using the AdvancedSearch method are listed below:

    • The search is performed in another thread. You don’t need to run another thread manually since the AdvancedSearch method runs it automatically in the background.
    • Possibility to search for any item types: mail, appointment, calendar, notes etc. in any location, i.e. beyond the scope of a certain folder. The Restrict and Find/FindNext methods can be applied to a particular Items collection (see the Items property of the Folder class in Outlook).
    • Full support for DASL queries (custom properties can be used for searching too). You can read more about this in the Filtering article in MSDN. To improve the search performance, Instant Search keywords can be used if Instant Search is enabled for the store (see the IsInstantSearchEnabled property of the Store class).
    • You can stop the search process at any moment using the Stop method of the Search class.