Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 25

Thread: Solved: Delete older emails with same subject line

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location

    Solved: Delete older emails with same subject line

    As I receive quite a few emails with the same subject line from VBA Express, is there a macro I can run which will delete all the older messages with duplicate subject lines, leaving only the newest?
    MD

    PS I have never attempted Outlook macros.

  2. #2
    Knowledge Base Approver VBAX Expert brettdj's Avatar
    Joined
    May 2004
    Location
    Melbourne
    Posts
    649
    Location
    Hi Malcom

    I had a crack at this below, the code moves the older messages into a subfolder called "Old". I'm wary whether the code always moves the correct old message with this line
    olInbox.Items(olItem.Subject).Move olDupe

    In my testing it worked but.....

    The code uses a Dictionary Object to hold the subject name and sender (so it wont cull messages from different senders with the same subject). I've used early binding so you need to set a reference to Microsoft Scripting Runtime.

    I think that the Find method would be a superior way of doing this speedwise, I'll have a play


    Cheers

    Dave


    [vba]
    Sub KillDupes()
    'Needs a reference to Microsoft Scripting Runtime
    Dim olSession As Outlook.Application, olNamespace As NameSpace
    Dim olInbox As Outlook.MAPIFolder, olDupe As Outlook.MAPIFolder
    Dim olItem As MailItem
    Dim olDict As Dictionary
    Set olSession = New Outlook.Application
    Set olDict = New Scripting.Dictionary
    Set olNamespace = olSession.GetNamespace("MAPI")
    Set olInbox = olNamespace.GetDefaultFolder(olFolderInbox)
    On Error Resume Next
    Set olDupe = olInbox.Folders("Old")
    If Err <> 0 Then Set olDupe = olInbox.Folders.Add("Old")
    On Error GoTo 0

    For Each olItem In olInbox.Items
    If TypeName(olItem) = "MailItem" Then
    If olDict.Exists(olItem.Subject & olItem.SenderName) Then
    'if the subject exists test to see which message is newer
    If olItem.ReceivedTime > olDict(olItem.Subject & olItem.SenderName) Then
    olInbox.Items(olItem.Subject).Move olDupe
    olDict.Remove olItem.Subject & olItem.SenderName
    olDict.Add olItem.Subject & olItem.SenderName, olItem.ReceivedTime
    Else
    ' move the current item if it is older
    olItem.Move olDupe
    End If
    Else
    olDict.Add olItem.Subject & olItem.SenderName, olItem.ReceivedTime
    End If
    End If
    Next
    Set olDict = Nothing
    Set olSession = Nothing
    End Sub
    [/vba]

  3. #3
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Thanks Dave,
    It works a treat on Inbox, but I commonly have one level of sub-folder within inbox so I've tweaked your code to the following:
    [VBA]
    Sub KillDupes()
    'Needs a reference to Microsoft Scripting Runtime
    Dim olSession As Outlook.Application, olNamespace As NameSpace
    Dim olInbox As Outlook.MAPIFolder, olDupe As Outlook.MAPIFolder
    Dim MyolInbox As Outlook.MAPIFolder
    Dim olItem As MailItem
    Dim olDict As Dictionary
    Dim MS
    MySubs = Array("EE", "VBA")

    Set olSession = New Outlook.Application
    Set olDict = New Scripting.Dictionary
    Set olNamespace = olSession.GetNamespace("MAPI")
    Set olInbox = olNamespace.GetDefaultFolder(olFolderInbox)

    For Each MS In MySubs
    Set MyolInbox = olInbox.Folders(MS)

    On Error Resume Next
    Set olDupe = olInbox.Folders("Old")
    If Err <> 0 Then Set olDupe = olInbox.Folders.Add("Old")
    On Error GoTo 0
    For Each olItem In MyolInbox.Items
    If TypeName(olItem) = "MailItem" Then
    If olDict.Exists(olItem.Subject & olItem.SenderName) Then
    'if the subject exists test to see which message is newer
    If olItem.ReceivedTime > olDict(olItem.Subject & olItem.SenderName) Then
    MyolInbox.Items(olItem.Subject).Move olDupe
    olDict.Remove olItem.Subject & olItem.SenderName
    olDict.Add olItem.Subject & olItem.SenderName, olItem.ReceivedTime
    Else
    ' move the current item if it is older
    olItem.Move olDupe
    End If
    Else
    olDict.Add olItem.Subject & olItem.SenderName, olItem.ReceivedTime
    End If
    End If
    Next
    Next
    Set olDict = Nothing
    Set olSession = Nothing
    End Sub

    [/VBA]

  4. #4
    VBAX Regular
    Joined
    Aug 2005
    Posts
    42
    Location
    Hi MD,

    Error msg ' Variables not defined ' appear for this line when I run your marco for a another layer of sub folder.

    [VBA]Dim MS
    My Subs = Array ("EE", "VBA")[/VBA]

    Would appreciate your guide on this line

    Thanks
    Our Greatest Glory is not in never falling, but in rising every time we fall

    There is great satisfaction in building good tools for others to use

  5. #5
    Knowledge Base Approver VBAX Expert brettdj's Avatar
    Joined
    May 2004
    Location
    Melbourne
    Posts
    649
    Location
    Malcolm,

    Did it always move the older message? I'm not sure if the code needs a sort routine or not. Please note this change

    [vba]
    Dim olItem As MailItem
    should be
    Dim olItem As Object
    [/vba]

    as the inbox may contain meeting requests, voicemail etc

    Cheers

    Dave

  6. #6
    Quote Originally Posted by brettdj
    Malcolm,

    Did it always move the older message? I'm not sure if the code needs a sort routine or not. Please note this change

    [vba]
    Dim olItem As MailItem
    should be
    Dim olItem As Object
    [/vba]

    as the inbox may contain meeting requests, voicemail etc

    Cheers

    Dave
    Hi Dave,

    I am new to macros so please bear with my lack of knowledge on the subject. The code is great and is exactly what I need for a makeshift inventory system I have set up for my small business utilizing QR codes and a smart phone to email the information. Sometimes the code works perfectly but sometimes the newer message is moved to the "old" folder. Any suggestions on how to fix this would be greatly appreciated.

    Thank you very much,

    Gene

  7. #7
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Hi Dave,
    It works fine. With the change I made, I only have emails in the two designated folders, but a useful filter anyway.
    Thanks
    Malcolm

  8. #8
    VBAX Mentor
    Joined
    Sep 2004
    Location
    Nashua, NH, USA
    Posts
    489
    Location
    This is the second time I've tried posting here.
    I guess I pushed the wrong button the first time.
    [VBA] Option Explicit
    Private Sub RemoveDuplicateSubjectSender()
    'Needs a reference to Microsoft Scripting Runtime
    'Needs a reference to Microsoft Outlook object library if not run in Outlook
    Dim i As Long
    Dim MyolInbox As Outlook.MAPIFolder
    Dim olInbox As Outlook.MAPIFolder
    Dim olNamespace As Outlook.NameSpace
    Dim olSession As Outlook.Application
    Dim strMailFolders() As String

    ReDim strMailFolders(1)
    strMailFolders(0) = "EE"
    strMailFolders(1) = "VBA"

    Set olSession = New Outlook.Application
    Set olNamespace = olSession.GetNamespace("MAPI")
    Set olInbox = olNamespace.GetDefaultFolder(olFolderInbox)

    On Error Resume Next
    RemoveDuplicates olInbox
    With olInbox
    For i = 0 To UBound(strMailFolders)
    Set MyolInbox = .Folders(strMailFolders(i))
    If Err.Number = 0 Then
    RemoveDuplicates MyolInbox
    Else
    Err.Clear
    End If
    Next i
    End With

    olSession.Quit
    Set MyolInbox = Nothing
    Set olInbox = Nothing
    Set olNamespace = Nothing
    Set olSession = Nothing
    End Sub
    Private Sub RemoveDuplicates(MyolInbox As Outlook.MAPIFolder)
    Dim olDict As Scripting.Dictionary
    Dim olDupe As Outlook.MAPIFolder
    ' Dim olItem As Outlook.MailItem
    Dim olItem As Object
    Dim strSubjectSender As String

    Set olDict = New Scripting.Dictionary
    On Error Resume Next
    Set olDupe = MyolInbox.Folders("Old")
    With Err
    If .Number <> 0 Then
    Set olDupe = MyolInbox.Folders.Add("Old")
    .Clear
    End If
    End With
    For Each olItem In MyolInbox.Items
    With olItem
    strSubjectSender = .Subject & .SenderName
    If TypeName(olItem) = "MailItem" Then
    If olDict.Exists(strSubjectSender) Then
    'if the subject exists test to see which message is newer
    If .ReceivedTime > olDict(strSubjectSender) Then
    MyolInbox.Items(.Subject).Move olDupe
    olDict.Remove strSubjectSender
    olDict.Add strSubjectSender, .ReceivedTime
    Else
    ' move the current item if it is older
    .Move olDupe
    End If
    Else
    olDict.Add strSubjectSender, .ReceivedTime
    End If
    End If
    End With
    Next
    Set olDict = Nothing
    Set olDupe = Nothing
    Set olItem = Nothing
    End Sub
    [/VBA]

  9. #9
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Hi Howard,
    I saw your earlier posting, now superceded by this one. I think you should reinstate your comments as to what this revised coding does.
    MD
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  10. #10
    VBAX Regular
    Joined
    Aug 2005
    Posts
    42
    Location
    Hi MD

    Using the above cause Outlook to prompt a security msg stating that a program is trying to gain access to the address book, is there a way to do
    away this security msg.

    Thanks
    Our Greatest Glory is not in never falling, but in rising every time we fall

    There is great satisfaction in building good tools for others to use

  11. #11
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  12. #12
    VBAX Regular
    Joined
    Aug 2005
    Posts
    42
    Location
    Quote Originally Posted by mdmackillop

    I have a look at the link provided, and removing New Outlook works in

    [VBA]Set olsession = New Outlook.Application[/VBA]


    Thanks
    Our Greatest Glory is not in never falling, but in rising every time we fall

    There is great satisfaction in building good tools for others to use

  13. #13
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    See what happens when I don't use Option Explicit!
    Should be[VBA]
    Dim MS, MySubs
    MySubs = Array("EE", "VBA")[/VBA]
    I had two sub-folders within "Inbox", EE & VBA.
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  14. #14
    VBAX Regular
    Joined
    Aug 2005
    Posts
    42
    Location
    MD, Excellent!!

    Thanks
    Our Greatest Glory is not in never falling, but in rising every time we fall

    There is great satisfaction in building good tools for others to use

  15. #15
    Hi, I got compile error on line
    Dim olDict As Dictionary
    Error is 'User-defined type not defined'.

    I have outlook 2000, any thoughts.

  16. #16
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Hi Skasu,
    Welcome to VBAX
    Did you notice this line?
    Regards
    MD
    [vba] 'Needs a reference to Microsoft Scripting Runtime[/vba]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  17. #17
    VBAX Regular
    Joined
    Dec 2007
    Posts
    78
    Location
    Quote Originally Posted by mdmackillop
    Hi Skasu,
    Welcome to VBAX
    Did you notice this line?
    Regards
    MD
    [vba] 'Needs a reference to Microsoft Scripting Runtime[/vba]
    I have tried to search Outlooks own help and I'll go on Google after I've posted this, but...obvious Noobie here...what is "Microsoft Scripting Runtime", how do you create a reference to it and what is the effect?

    I think in hindsight the problem was in my coding.

  18. #18
    VBAX Regular
    Joined
    Dec 2007
    Posts
    78
    Location
    Quote Originally Posted by Asterix
    I have tried to search Outlooks own help and I'll go on Google after I've posted this, but...obvious Noobie here...what is "Microsoft Scripting Runtime", how do you create a reference to it and what is the effect?
    Own question answered, GIMF... http://msdn.microsoft.com/en-us/libr...ffice.10).aspx

    I think in hindsight the problem was in my coding.

  19. #19
    VBAX Regular
    Joined
    Dec 2007
    Posts
    78
    Location
    Code works fine but in my case I'm looking to remove older emails from a shared groupbox, displayed like this...

    - Mailbox - Thegaul, Asterix
    Archive
    Deleted Items
    Drafts
    Inbox
    Junk E-mail
    Outbox
    Sent Items
    Search Folders
    - Mailbox - Groupbox, Our
    Deleted Items
    Inbox
    Outbox
    Sent Items
    Search Folders

    It's the "- Mailbox - Groupbox, Our", "Inbox" that I want to remove the older emails from. Any idea how I can modify this code to do this?

    I think in hindsight the problem was in my coding.

  20. #20
    VBAX Regular
    Joined
    Dec 2007
    Posts
    78
    Location
    Ok, this code works but in my case, I'm not looking to remove older emails in *my* inbox. I'm looking to remove older emails in a group mailbox which I can see like this...
    [quote]
    Mailbox - Thegaul, Asterix

    I think in hindsight the problem was in my coding.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •