Search code examples
vbaemailoutlook

Automatically remove duplicate recipients before manually send ReplyAll, (Run-time error '91': Object variable or With block variable not set)


I am using a macro to add specific recipients (Contact_group) to my ReplyAll email, depends on a condition and it works as it should.
But I found that the original mail may already contain some recipients from my “contact_group” and this leads to a duplication.
I googled and found a code to remove duplicate recipients, and because this code (Sub Remove_Duplicate_Recipients) is lengthy then I put on a separate module.
When I manually run Sub Remove_Duplicate_Recipients while the ReplyAll window is still open, then it works correctly as it should.
For automation purpose, I need to run automatically the cited sub , by calling it from ThisOutlookSession,
But I got

Run-time error '91': Object variable or With block variable not set

At this line Set objCurrentMail = ActiveInspector.CurrentItemof on Sub Remove_Duplicate_Recipients

The below code is found in (ThisOutlookSession)

Option Explicit
Option Compare Text
Private WithEvents myAttExp As Explorer
Private WithEvents myAttOriginatorMail As MailItem
Dim WithEvents oMailItem As Outlook.MailItem

Private Sub Application_Startup()
    Set myAttExp = ActiveExplorer
End Sub

Private Sub myAttOriginatorMail_ReplyAll(ByVal Response As Object, Cancel As Boolean)
  If Response.Body Like "*Test*" Then
      Response.Recipients.Add ("TestGroup")  'name of Contact_Group
       Response.Recipients.ResolveAll
       Remove_Duplicate_Recipients
  End If

End Sub

Private Sub myAttExp_SelectionChange()
  On Error Resume Next
    If TypeOf myAttExp.Selection.Item(1) Is MailItem Then
        Set myAttOriginatorMail = myAttExp.Selection.Item(1)
    End If
End Sub

And this sub is found on a separate module:

Option Explicit
Option Compare Text

Sub Remove_Duplicate_Recipients()

    Dim objCurrentMail As MailItem
    Dim objRecipients As Recipients
    Dim ContactGroupFound As Boolean
    Dim i As Long, n As Long
 
    Set objCurrentMail = ActiveInspector.CurrentItem
    
    ContactGroupFound = True
 
    While ContactGroupFound = True
          Set objRecipients = objCurrentMail.Recipients
          ContactGroupFound = False
 
    'Expand the contact groups in "To" field
          For i = objRecipients.Count To 1 Step -1
              If objRecipients(i).AddressEntry.DisplayType <> olUser Then
                 For n = 1 To objRecipients(i).AddressEntry.Members.Count
                     If objRecipients(i).AddressEntry.Members.Item(n).DisplayType = olUser Then
                        objCurrentMail.Recipients.Add (objRecipients(i).AddressEntry.Members.Item(n).Address)
                     Else
                        objCurrentMail.Recipients.Add (objRecipients(i).AddressEntry.Members.Item(n).Name)
                        ContactGroupFound = True
                     End If
                 Next
                 objRecipients(i).Delete
              End If
          Next i
          objRecipients.ResolveAll
    Wend
 
'Remove the duplicate recipients
    For i = objRecipients.Count To 1 Step -1
        For n = (i - 1) To 1 Step -1
            If objRecipients(i).Address = objRecipients(n).Address Then
               objRecipients(i).Delete
               Exit For
            End If
        Next
    Next
    
End Sub

Solution

  • To specify the ReplyAll item in myAttOriginatorMail_ReplyAll:

    Private Sub myAttOriginatorMail_ReplyAll(ByVal Response As Object, Cancel As Boolean)
      
        If Response.Body Like "*Test*" Then
            Response.Recipients.Add ("TestGroup")  'name of Contact_Group
            Response.Recipients.ResolveAll
           
            Remove_Duplicate_Recipients_withParameter Response
    
        End If
    
    End Sub
    
    Sub Remove_Duplicate_Recipients_withParameter(objCurrentMail As MailItem)
    
        'Dim objCurrentMail As MailItem
        Dim objRecipients As Recipients
        Dim ContactGroupFound As Boolean
        Dim i As Long, n As Long
     
        'Set objCurrentMail = ActiveInspector.currentItem
        
        ContactGroupFound = True
     
        ' ...
        
    End Sub