?
Solved

Outlook Macro

Posted on 2012-03-21
2
Medium Priority
?
573 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 2000 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

New benefit for Premium Members - Upgrade now!

Ready to get started with anonymous questions today? It's easy! Learn more.

Question has a verified solution.

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

This article describes a serious pitfall that can happen when deleting shapes using VBA.
If you troubleshoot Outlook for clients, you may want to know a bit more about the OST file before doing your next job. IMAP can cause a lot of drama if removed in the accounts without backing up.
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.
Suggested Courses

777 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