Delete older emails with same subject line

[Howard Kaikow]

This is the second time I've tried posting here.
I guess I pushed the wrong button the first time.

 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