Forward your Mail and Appointments to another e-mail address

[dhilipkumar]

Code:

Option Explicit
Private WithEvents oOutlook As Outlook.Application
Private WithEvents oMailItems As Outlook.Items
Private WithEvents oCalendarItems As Outlook.Items
Private strForwardTo As String

Private Sub Class_Initialize()
    'Create an private outlook session
    Set oOutlook = New Outlook.Application
    'Get the calendar and inbox objects
    Set oMailItems = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
    Set oCalendarItems = Outlook.Session.GetDefaultFolder(olFolderCalendar).Items
End Sub

Private Sub Class_Terminate()
    Set oOutlook = Nothing
    Set oMailItems = Nothing
    Set oCalendarItems = Nothing
End Sub

'Forward New Appointments
Private Sub oCalendarItems_ItemAdd(ByVal Item As Object)
    Dim oForward As MailItem
     
    If TypeName(Item) = "AppointmentItem" Then
        'Forward the appointment
        Set oForward = Item.ForwardAsVcal
        oForward.Recipients.Add strForwardTo
        'Send it
        oForward.Send
        Set oForward = Nothing
    End If
End Sub

'Forward New Mail
Private Sub oMailItems_ItemAdd(ByVal Item As Object)
    Dim oForward As MailItem
     
    If TypeName(Item) = "MailItem" Then
        'Forward the item just received
        Set oForward = Item.Forward
        'Address the message
        oForward.Recipients.Add strForwardTo
        'Send it
        oForward.Send
        Set oForward = Nothing
    End If
End Sub


Property Get ForwardTo() As String
    ForwardTo = strForwardTo
End Property

Property Let ForwardTo(Value As String)
    strForwardTo = Value
End Property

[dhilipkumar]

Now add this code to a Standard Module and call the StartForward routine to begin the fowarding.


Code:
Option Explicit

Private oMailForward As clsForward

Sub StartForward()
    Set oMailForward = New clsForward
    oMailForward.ForwardTo = "myname@somewhere.com"
End Sub

Sub StopForward()
    Set oMailForward = Nothing
End Sub