Tuesday, 27 August 2013

How can I modify this outlook macro and related queries ( to remove older emails in email thread with same subject )?

How can I modify this outlook macro and related queries ( to remove older
emails in email thread with same subject )?

A macro noob here!
This macro was found
online(https://www.google.com/url?sa=t&rct=j&q=&esrc=s&source=web&cd=3&cad=rja&ved=0CD4QFjAC&url=http%3A%2F%2Fdevsac.blogspot.com%2F2009%2F06%2Fvb-macro-for-deleting-duplicate-outlook.html&ei=h38dUuO3DYq6sQS-h4HoBg&usg=AFQjCNEtgpYzqIn5zBNYWbBwOQU_v72lGw&sig2=_3c3PePjsDolGRE2FqBqbg)
and people who used were extremely happy about it.
I have few queries regarding the scope of utility wrt to my situation.
1)Does this macro work only for the same subject ? Or does it look for the
same subject line in the subject of other emails as well ? ( For e.g. can
it differentiate between subject='Server log is late' and subject='RE:
Server log is late' ?. This is from the same email thread where one is the
first email in the thread and other is its reply)
2) I have a common inbox (that is accessible to all the members in my
group i.e for our group email ID )where all the mails turn up . Can this
macro be used for such an email inbox that is shared with everyone in my
group?
3) Also, is it possible to modify the code such that it can pick emails
(from the same inbox) that have the same subject but ignores the emails
with same subject that contains 'FW:' at the beginning of the subject line
?
4) Does this works for pst only or will it work for the emails currently
residing in the inbox as well ?
i.e ' FW: RE:RE: hello ' will be ignored whereas ' RE:RE: hello' and
'RE:RE:FW: RE: hello' will be marked.
Since at times when an email is forwarded , a new email thread gets
created containing different conversation. So I don't want conversations
that are different from the main email thread to be marked as it has
different emails under the same subject line.
Thanks.
Vincen



Const PST1_NAME = "NewBackup"
Const PST2_NAME = "NewBackup"
Const FOLDER1_NAME = "Inbox"
Const FOLDER2_NAME = "OldInbox"
Const CATEGORY_SEPERATOR = ","
Const FINAL_PROGRESS_ALLOCATED = 20 ' between 1 and 100
Public progressValue 'this holds the percentage completed.
Public progressStatus 'this holds the current status.
' sample with hardcoded psts & folders
Private Sub markDuplicateEmails()
markDuplicates PST1_NAME & SEPERATOR & FOLDER1_NAME, PST2_NAME & SEPERATOR
& FOLDER2_NAME, DEFAULT_CATEGORY
End Sub
' actual method which takes dynamic pst\folder source and destination
Public Sub markDuplicates(source, destination, category)
Dim myOlApp, myNameSpace
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Dim tmpArray, pst1Name, pst2Name, folder1Name, folder2Name
tmpArray = Split(source, SEPERATOR)
pst1Name = tmpArray(0)
folder1Name = tmpArray(1)
tmpArray = Split(destination, SEPERATOR)
pst2Name = tmpArray(0)
folder2Name = tmpArray(1)
Dim folder1Size, folder2Size
folder1Size = myNameSpace.Folders(pst1Name).Folders(folder1Name).Items.Count
folder2Size = myNameSpace.Folders(pst2Name).Folders(folder2Name).Items.Count
Dim array1() As cstData, array2() As cstData
ReDim array1(folder1Size)
ReDim array2(folder2Size)
Dim outlookItem1, outlookItem2, i, j
Dim theCstmData As Module1.cstData
Dim startTime, endTime
'populate array1
i = -1
startTime = Now
progressStatus = "Indexing set1..."
For Each outlookItem1 In
myNameSpace.Folders(pst1Name).Folders(folder1Name).Items
i = i + 1
Set theCstmData.item = outlookItem1
theCstmData.subject = outlookItem1.subject
theCstmData.creationTime = outlookItem1.creationTime
array1(i) = theCstmData
progressValue = 100 * (i / (folder1Size + folder2Size + (folder1Size +
folder2Size) * (FINAL_PROGRESS_ALLOCATED / 100)))
DoEvents
Next outlookItem1
progressStatus = "Indexing set1 Complete."
' populate array2
i = -1
progressStatus = "Indexing set2..."
For Each outlookItem2 In
myNameSpace.Folders(pst2Name).Folders(folder2Name).Items
i = i + 1
Set theCstmData.item = outlookItem2
theCstmData.subject = outlookItem2.subject
theCstmData.creationTime = outlookItem2.creationTime
array2(i) = theCstmData
progressValue = 100 * ((folder1Size + i) / (folder1Size + folder2Size +
(folder1Size + folder2Size) * (FINAL_PROGRESS_ALLOCATED / 100)))
DoEvents
Next outlookItem2
progressStatus = "Indexing set2 Complete."
progressStatus = "Indexing time: " & (Now - startTime) * 60 * 60 * 24
'loop through each item in array1
progressStatus = "Applying Category labels on duplicates..."
For i = 0 To folder1Size - 1
'loop through each item in array 2 comparing each array2Item with current
array1item
For j = 0 To folder2Size - 1
' if it is a match mark the item in array2 as duplicate
If array1(i).subject = array2(j).subject And _
array1(i).creationTime = array2(j).creationTime Then
If array1(i).item.Categories = "" Then
array1(i).item.Categories = category
Else
array1(i).item.Categories = array2(j).item.Categories & CATEGORY_SEPERATOR
& category
End If
array1(i).item.Save
If array2(j).item.Categories = "" Then
array2(j).item.Categories = category
Else
array2(j).item.Categories = array2(j).item.Categories & CATEGORY_SEPERATOR
& category
End If
array2(j).item.Categories = category
array2(j).item.Save
End If
DoEvents
Next j
progressValue = (100 - FINAL_PROGRESS_ALLOCATED) +
(FINAL_PROGRESS_ALLOCATED * (i / folder1Size))
Next i
progressStatus = "Total Time: " & (Now - startTime) * 60 * 60 * 24
progressStatus = "All done."
End Sub

No comments:

Post a Comment