Outlook Macro

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?
runnerjp2005Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

dlmilleCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
runnerjp2005Author Commented:
Thats amazing dave thanks!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.