Solved

Outlook Macro

Posted on 2012-03-21
2
572 Views
Last Modified: 2012-08-14
Is it possible to create a macro that Runs in outlook on advanced find with the following search criteria:

From: doesn't contain "TS Service Desk"
Subject: doesn't contain  "Incident PS"

and look for email with today's date and does not show duplicates with the same subject?
0
Comment
Question by:runnerjp2005
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 42

Accepted Solution

by:
dlmille earned 500 total points
ID: 37751836
You haven't included some parameters in your request.  For example, what type of output are you looking for?  A list of subject/dates in a workbook?  A messagebox with each of the subject/dates?  Do you want to be able to read the emails or just see a list?  Etc.

I'm assuming you want the results to be in a search folder, as if you ran this manually, using the Advanced Search feature (which you could do, then just rerun your saved search).  Not sure why you want a macro to do this???

http://www.living-with-outlook.com/advanced-find.html

At any rate, as it was a chance to learn abit about writing advanced search macros, I took on this endeavor.  I got the results to a search folder called, "MySearchFolder" (I had a heck of a time figuring out how to delete it, then ran across a script that would do just that!).

So, this is quite elegant, however, its not possible to eliminate duplicates from this list, as that would delete the actual mails.  So, we keep it as is, in a search folder, or you specify an alternate method in how you'd like to see the result list.

I can give you the additional code to delete duplicates based on subject, but it will delete the actual emails that are "duplicates"  That code is commented in the below, in case that's exactly what you want.

The macro to run is: TestAdvancedSearchComplete()

Here's the code that goes in ThisOutlookSession codepage of Outlook:

'Option Explicit
'Advanced Search of Inbox:
'--->>> From: Does not contain "TS Service Desk"
'--->>> Subject: Does not contain "Incident PS"
'--->>> Date: Today's date
'--->>> No duplicates with the same subject

'Source: adapted from http://msdn.microsoft.com/en-us/library/aa220071(v=office.11).aspx

Public blnSearchComp As Boolean

Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Search)
'MsgBox "The AdvancedSearchComplete Event fired"
    blnSearchComp = True
End Sub

Sub TestAdvancedSearchComplete()
Dim sch As Outlook.Search
Dim rsts As Outlook.Results
Dim i As Integer

Dim MySearch As Outlook.Search
Dim MyTable As Outlook.Table
Dim nextRow As Outlook.Row
Dim strF As String
Dim strS As String
Dim oFolder As Outlook.MAPIFolder
Dim oItem As Outlook.MailItem
Dim myDict As Object 'dictionary for unique list

    'create dictionary
    Set myDict = CreateObject("Scripting.Dictionary")
    
    'first, delete the old search folder, if it exists
    Call DeleteSFItem("MySearchFolder")
    blnSearchComp = False
    
    strF = "(NOT ""urn:schemas:httpmail:fromname"" LIKE '%TS Service Desk%') AND " & _
          "(NOT ""urn:schemas:httpmail:subject"" LIKE '%Incident PS%') AND " & _
          "%thismonth(""urn:schemas:httpmail:datereceived"")%"
    strS = "Inbox"
    Set MySearch = Application.AdvancedSearch(Scope:=strS, Filter:=strF, Tag:="MySearch")
    While blnSearchComp = False
        DoEvents
    Wend

    'Save the search folder
    Set oFolder = MySearch.Save("MySearchFolder")

    'uncomment the below to delete duplicates based on subject, keeping only the first unique instance found
    For Each oItem In oFolder.Items
        If myDict.exists(oItem.Subject) Then 'already have one, so delete any other
            'oItem.Delete '<- uncomment this line to delete any additional duplicates
        Else
            myDict.Add oItem.Subject, Nothing
        End If
    Next oItem
    
    'cleanup
    myDict.RemoveAll
    Set myDict = Nothing
End Sub
Sub DeleteSFItem(mySearchFolder As String)
'Source:http://blogs.msdn.com/b/stephen_griffin/archive/2009/05/21/less-than-portable-search-folders.aspx
    Dim CommonViewsEIDBin As String
    Dim CommonViewsEIDString As String
    Dim CommonViewsFolder As Folder
    Dim ACTable As Table
    Dim oRow As Row
    Dim SFDefinitionEID As String
    Dim SFDefinitionItem As StorageItem
        
    CommonViewsEID = Session.DefaultStore.PropertyAccessor.GetProperty( _
        "http://schemas.microsoft.com/mapi/proptag/0x35E60102")
    CommonViewsEIDString = Session.DefaultStore.PropertyAccessor.BinaryToString( _
        CommonViewsEID)
    Set CommonViewsFolder = Session.GetFolderFromID(CommonViewsEIDString)
    Set ACTable = CommonViewsFolder.GetTable( _
        "[Subject] = '" & mySearchFolder & "'", olHiddenItems)
    
    Set oRow = ACTable.GetNextRow()
    If (Not (oRow Is Nothing)) Then
        SFDefinitionEID = oRow("EntryID")
        Set SFDefinitionItem = Session.GetItemFromID(SFDefinitionEID)
        SFDefinitionItem.Delete
    End If
End Sub

Open in new window


Cheers,

Dave
0
 

Author Closing Comment

by:runnerjp2005
ID: 37766575
Thats amazing dave thanks!
0

Featured Post

Creating Instructional Tutorials  

For Any Use & On Any Platform

Contextual Guidance at the moment of need helps your employees/users adopt software o& achieve even the most complex tasks instantly. Boost knowledge retention, software adoption & employee engagement with easy solution.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This article describes how to import an Outlook PST file to Office 365 using a third party product to avoid Microsoft's Azure command line tool, saving you time.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

717 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question