Solved

Outlook Macro

Posted on 2012-03-21
2
562 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
2 Comments
 
LVL 41

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

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Set OWA language and time zone in Exchange for individuals, all users or per database.
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

757 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now