View Single Post
  #6  
Old November 4th 08, 10:15 PM posted to microsoft.public.outlook.program_vba
Ken Slovak - [MVP - Outlook]
external usenet poster
 
Posts: 5,848
Default Email Forwarding

Something like this, although this has no real error handling and needs to
be tweaked so there's no possibility of an endless loop. This code would go
into the ThisOutlookSession class module in the Outlook VBA project.

You would of course have to sign the project or lower macro security to have
it run.

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim aID() As String
Dim oMail As Outlook.MailItem
Dim oFwd As Outlook.MailItem
Dim oNS As Outlook.NameSpace
Dim oRecip As Outlook.Recipient
Dim obj As Object
Dim i As Long
Dim sBody As String

Const SEARCH_FOR As String = "Foobar"
Const SEARCH_ADDY As String = "
Const FORWARD_TO As String = "

Set oNS = Application.GetNamespace("MAPI")

On Error Resume Next

aID = Split(EntryIDCollection, ",")
For i = LBound(aID) To UBound(aID)
Set obj = oNS.GetItemFromID(aID(i))
If obj.Class = olMail Then
Set oMail = obj
sBody = oMail.Body
If ((InStr(1, sBody, SEARCH_FOR, vbTextCompare) 0) And _
(oMail.SenderEmailAddress = SEARCH_ADDY)) Then

Set oFwd = oMail.Forward
Set oRecip = oFwd.Recipients.Add(FORWARD_TO)
oRecip.Resolve
If oRecip.Resolved Then
oFwd.Send
End If

End If
End If

Set oMail = Nothing
Set oFwd = Nothing
Set oRecip = Nothing
Set obj = Nothing
Next

Set oNS = Nothing
End Sub

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm


"TerryM" wrote in message
...
That's more of what I was looking for, but like I stated before. I'm
relatively new to VBA programming especially in Outlook. Were more of a
Delphi place, what would the code that I'm requiring look like?


Ads