Visual Basic Programming Code Examples

Visual Basic > Internet Web Mail Stuff Code Examples

Outlook 2000 class to automatically forward new mail



Outlook 2000 class to automatically forward new mail

Below is the code from a class module which automatically forward emails using Outlook. This can be extremely useful if you want to redirect your emails while your away on holiday, or if you company blocks the use of internet emails and your home PC uses an unlimited dial up connection (like ADSL/broadband).

'NOTE: This class requires a reference to
'Microsoft Outlook 9.0 Object Library (msoutl9.olb)

Private WithEvents oOutlookApp As Outlook.Application
Private oNameSpace As Outlook.NameSpace, oInBox As Outlook.MAPIFolder
Private zsForwardTo As String, zbDeleteMailAfterForward As Boolean

'Purpose   :    Forwards all new messages in the inbox
'Inputs    :    N/A
'Outputs   :    N/A


Private Sub ForwardNewMail()
    Dim oMailItem As Outlook.MailItem, oReply As Outlook.MailItem
    
    'Loop over all mail in mail box
    For Each oMailItem In oInBox.Items
        If oMailItem.UnRead Then
            'Forward new message
            Set oReply = oMailItem.Forward
            oReply.To = zsForwardTo
            oReply.Send
            oMailItem.UnRead = False
            If zbDeleteMailAfterForward Then
                'Delete Mail
                oMailItem.Delete
            End If
        End If
    Next
    Set oReply = Nothing
End Sub

Private Sub Class_Initialize()
    Set oOutlookApp = New Outlook.Application
    Set oNameSpace = oOutlookApp.GetNamespace("MAPI")
    Set oInBox = oNameSpace.GetDefaultFolder(olFolderInbox)
End Sub

Private Sub Class_Terminate()
    Set oInBox = Nothing
    Set oNameSpace = Nothing
    Set oOutlookApp = Nothing
End Sub

Private Sub oOutlookApp_NewMail()
    If Len(zsForwardTo) Then
        ForwardNewMail
    End If
End Sub

'The email address of the person to forward the messages to
Property Get ForwardTo() As String
    ForwardTo = zsForwardTo
End Property

Property Let ForwardTo(Value As String)
    zsForwardTo = Value
    'Check the inbox for new mail
    oOutlookApp_NewMail
End Property

'If True the new mails will be deleted after being forwarded
Property Get DeleteMailAfterForward() As Boolean
    DeleteMailAfterForward = zbDeleteMailAfterForward
End Property

Property Let DeleteMailAfterForward(Value As Boolean)
    zbDeleteMailAfterForward = Value
End Property