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