vbaoutlookoutlook-2003

Outlook 2003 VB Script to create forwarding rule


Hello does anyone know how to create a VB Script that will add a rule in Outlook 2003 such that if I receive an email from user PersonA@mail.com it will forward that email to PersonB@mail.com.

I would also like to know if it possible to create a VB Script to remove the previously created rule.

I've done a little research and it seems possible to create a macro to do this, but I am completely lost as I am not familiar with the objects I need to be editing or have any sort of API.

Maybe I have to create a Macro to add the rules and this use a VB script to fire the Macro.


Solution

  • I would use straight VBA instead. The ItemAdd Event can be used to check your default Inbox for incoming messages and forward them. It is simple to edit the email addresses if you need to change the forwarding.

    Ex:

    Private WithEvents Items As Outlook.Items 
    Private Sub Application_Startup() 
    Dim olApp As Outlook.Application 
    Dim objNS As Outlook.NameSpace 
    Set olApp = Outlook.Application 
    Set objNS = olApp.GetNamespace("MAPI") 
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items 
    End Sub
    Private Sub Items_ItemAdd(ByVal item As Object) 
    On Error Goto ErrorHandler 
    Dim Msg As Outlook.MailItem 
    Dim newMsg As Outlook.MailItem
    Dim recip As Outlook.Recipient
    
    ' *****************
    ' edit these to change forwarding rules
    ' *****************
    Const INCOMING_EMAIL As String = "Persion@mail.com"
    Const OUTGOING_EMAIL As String = "PersonB@mail.com"
    
    If TypeName(item) = "MailItem" Then
    Set Msg = item
      If Msg.SenderEmailAddress = INCOMING_EMAIL Then
        Set newMsg = Msg.Forward
    
        With newMsg
          Set recip = .Recipients.Add OUTGOING_EMAIL
          recip.Type = olTo
          .Send
        End With
        ' *****************
        ' perhaps a msgbox?
        ' MsgBox "Message forwarded", vbInformation
        ' *****************
      End If
    End If
    ProgramExit: 
    Exit Sub
    ErrorHandler: 
    MsgBox Err.Number & " - " & Err.Description 
    Resume ProgramExit 
    End Sub
    

    This code should be placed in ThisOutlookSession module, then you must restart Outlook. If you need placement assistance see Where do I put my Outlook VBA code?