If email not sent to specific user

I am attempting to write a macro... or locate a rule that when an email comes
in from a specific person with a specific subject line to check to see if a
specific person is either in copy or in the To line of the email. If the
person is not in the To or Copy line, then I want the email forwarded to that
person.

I write code in Excel and Access constantly, but this would be the first
time in Outlook.

I dont really know where to start because after looking at other coding, it
seems that I would have to specific to look in Outlook then at emails then at
a specific email then at the To line or CC line etc in order to find this.
Any help would be extremely appreciated on this matter.

This should work. Simply edit the "specific person" and "specific
subject" to your taste.

1. Place this in ThisOutlookSession module:

Private WithEvents Items As Outlook.Items

2. In your "Application_Startup" event, this code:

Dim objNS As Outlook.NameSpace
Set objNS = Application.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items

(if you don't already have a Startup event, simply paste "Private Sub
Application_Startup()" into ThisOutlookSession first, then paste the
code above.)

3. Paste this code into ThisOutlookSession:

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
If sRecip.Name = "other specific person" Then
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


HTH,
JP

On Dec 19, 11:32 am, Thomas [PBD]
<Thomas...@discussions.microsoft.com> wrote:
> I am attempting to write a macro... or locate a rule that when an email comes
> in from a specific person with a specific subject line to check to see if a
> specific person is either in copy or in the To line of the email. If the
> person is not in the To or Copy line, then I want the email forwarded to that
> person.
>
> I write code in Excel and Access constantly, but this would be the first
> time in Outlook.
>
> I dont really know where to start because after looking at other coding, it
> seems that I would have to specific to look in Outlook then at emails then at
> a specific email then at the To line or CC line etc in order to find this.
> Any help would be extremely appreciated on this matter.

Sorry, just realized my code will forward the email if the person IS
in the recipient list, not if they are NOT in the recipient list.

You could amend the code as such

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


HTH,
JP

On Dec 19, 11:32 am, Thomas [PBD]
<Thomas...@discussions.microsoft.com> wrote:
> I am attempting to write a macro... or locate a rule that when an email comes
> in from a specific person with a specific subject line to check to see if a
> specific person is either in copy or in the To line of the email. If the
> person is not in the To or Copy line, then I want the email forwarded to that
> person.
>
> I write code in Excel and Access constantly, but this would be the first
> time in Outlook.
>
> I dont really know where to start because after looking at other coding, it
> seems that I would have to specific to look in Outlook then at emails then at
> a specific email then at the To line or CC line etc in order to find this.
> Any help would be extremely appreciated on this matter.

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
If sRecip.Name = "other specific person" Then
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







"JP" wrote:

> This should work. Simply edit the "specific person" and "specific
> subject" to your taste.
>
> 1. Place this in ThisOutlookSession module:
>
> Private WithEvents Items As Outlook.Items
>
> 2. In your "Application_Startup" event, this code:
>
> Dim objNS As Outlook.NameSpace
> Set objNS = Application.GetNamespace("MAPI")
> Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
>
> (if you don't already have a Startup event, simply paste "Private Sub
> Application_Startup()" into ThisOutlookSession first, then paste the
> code above.)
>
> 3. Paste this code into ThisOutlookSession:
>
> 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
> If sRecip.Name = "other specific person" Then
> 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
>
>
> HTH,
> JP
>
> On Dec 19, 11:32 am, Thomas [PBD]
> <Thomas...@discussions.microsoft.com> wrote:
> > I am attempting to write a macro... or locate a rule that when an email comes
> > in from a specific person with a specific subject line to check to see if a
> > specific person is either in copy or in the To line of the email. If the
> > person is not in the To or Copy line, then I want the email forwarded to that
> > person.
> >
> > I write code in Excel and Access constantly, but this would be the first
> > time in Outlook.
> >
> > I dont really know where to start because after looking at other coding, it
> > seems that I would have to specific to look in Outlook then at emails then at
> > a specific email then at the To line or CC line etc in order to find this.
> > Any help would be extremely appreciated on this matter.
>
>

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


"JP" wrote:

> Sorry, just realized my code will forward the email if the person IS
> in the recipient list, not if they are NOT in the recipient list.
>
> You could amend the code as such
>
> 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
>
>
> HTH,
> JP
>
> On Dec 19, 11:32 am, Thomas [PBD]
> <Thomas...@discussions.microsoft.com> wrote:
> > I am attempting to write a macro... or locate a rule that when an email comes
> > in from a specific person with a specific subject line to check to see if a
> > specific person is either in copy or in the To line of the email. If the
> > person is not in the To or Copy line, then I want the email forwarded to that
> > person.
> >
> > I write code in Excel and Access constantly, but this would be the first
> > time in Outlook.
> >
> > I dont really know where to start because after looking at other coding, it
> > seems that I would have to specific to look in Outlook then at emails then at
> > a specific email then at the To line or CC line etc in order to find this.
> > Any help would be extremely appreciated on this matter.
>
>

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] <Thomas...@discussions.microsoft.com>
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