Remove the first "For Each sRecip In Msg.Recipients", it looks like it
was duplicated. Also change "Exit For" to "Exit Sub", or add an error
handler to go straight to the end of the code where the object
variables are released.


HTH,
--JP


On Dec 19, 3:37 pm, Thomas [PBD]
wrote:
Therefore, the ThisOutlookSession Module should read:

Private WithEvents Items As Outlook.Items
-----------------------------------------------------------------
Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
------------------------------------------------------------------
Private Sub Items_ItemAdd(ByVal Item As Object)

If TypeOf Item Is Outlook.MailItem Then
Dim Msg As Outlook.MailItem
Dim NewFwd As Outlook.MailItem
Dim sRecip As Outlook.Recipient
Set Msg = Item

If Msg.SenderName = "specific person" Then
If Msg.Subject = "specific subject" Then
For Each sRecip In Msg.Recipients
counter = 0
For each sRecip in Msg.Recipients
If sRecip.Name = "other specific person" Then
Exit For ' they were sent the email, we can safely exit
Else
counter = counter + 1
end if
Next sRecip

If counter = Msg.Recipients.Count Then ' we cycled through each
recipient and did not find this one
Set NewFwd = Msg.Forward
NewFwd.Recipients.Add("other specific person").Type = olTo
NewFwd.Display ' or .Send
End if
Next sRecip
End If
End If

End If

Set NewFwd = Nothing
Set Msg = Nothing

End Sub