How to use the Rule.dll sample to create an inbox rule in Visual Basic

Option Explicit
Const SUBJECT_TO_SEARCH = "Test"
Public Function AddReplyAndDeleteRule(ByVal strProfileInfo As String) As Long

Dim objCDOSession As MAPI.Session                ' CDO Session.
Dim objInbox As MAPI.Folder                      ' Folder to set rule.
Dim colRules As MSExchange.Rules                 ' Rules collection.
Dim objReplyMsg As MAPI.Message                  ' Reply template.
Dim objReplyRule As MSExchange.Rule
Dim objDeleteRule As MSExchange.Rule
Dim objPropVal As MSExchange.PropVal             ' Property value.
Dim objContCond As MSExchange.ContentCondition   ' Condition.
Dim objReplyAction As MSExchange.Action
Dim objDeleteAction As MSExchange.Action

Const SUBSTRING = 1
Const IGNORECASE = &H10000
Const ACTION_DELETE = 3
Const ACTION_REPLY = 4
Const CdoPR_SUBJECT = &H37001E

On Error GoTo Error_Handler

' Create and log on to session object.
Set objCDOSession = New MAPI.Session
objCDOSession.Logon , , False, True, True, True, strProfileInfo
Set objInbox = objCDOSession.Inbox

'Each folder has a Rules collection.
Set colRules = New MSExchange.Rules
colRules.Folder = objInbox

' Create condition for rules.
Set objPropVal = New MSExchange.PropVal
objPropVal.Tag = CdoPR_SUBJECT  'looks in Subject property
objPropVal.Value = SUBJECT_TO_SEARCH 'looks for this string

' Create ContentCondition
Set objContCond = New MSExchange.ContentCondition
objContCond.Value = objPropVal
objContCond.PropertyType = CdoPR_SUBJECT
objContCond.Operator = SUBSTRING + IGNORECASE
' Previous line ignores case and other text.

' Create reply message and store in HiddenMessages collection.
Set objReplyMsg = objInbox.HiddenMessages.Add

' Set reply message properties.
objReplyMsg.Type = "IPM.Note.Rules.ReplyTemplate.Microsoft"
objReplyMsg.Text = "Please do not send messages to this address"
objReplyMsg.Update

' Create Reply Rule first.
Set objReplyRule = New MSExchange.Rule

' Set reply action.
Set objReplyAction = New MSExchange.Action
objReplyAction.ActionType = ACTION_REPLY

Dim vntArgs(1) As Variant
vntArgs(0) = objReplyMsg.ID       ' ID of template
vntArgs(1) = objReplyMsg.FolderID ' folder ID of template
objReplyAction.Arg = vntArgs      ' Set the args

' Set other reply rule properties.
objReplyRule.Name = "Reply Test"
objReplyRule.Condition = objContCond
objReplyRule.Actions.Add , objReplyAction

' Add reply rule to rules collection.
colRules.Add , objReplyRule

' Create Delete Rule object.
Set objDeleteRule = New MSExchange.Rule

' Create delete action.
Set objDeleteAction = New MSExchange.Action
objDeleteAction.ActionType = ACTION_DELETE

' Set delete rule properties.
objDeleteRule.Name = "Delete Test"
objDeleteRule.Condition = objContCond  'reuse condition
objDeleteRule.Actions.Add , objDeleteAction
colRules.Add , objDeleteRule
colRules.Update

' Wrap up.
objCDOSession.Logoff
AddReplyAndDeleteRule = 0  'successful

Set objPropVal = Nothing
Set objContCond = Nothing
Set objReplyAction = Nothing
Set objDeleteAction = Nothing
Set objReplyRule = Nothing
Set objDeleteRule = Nothing
Set objReplyMsg = Nothing
Set colRules = Nothing
Set objInbox = Nothing
Set objCDOSession = Nothing

Exit Function

Error_Handler:
AddReplyAndDeleteRule = Err.Number

End Function

Dim lResult As Long
' TODO Change the ServerName and MailBox to the appropriate names.
lResult = AddReplyAndDeleteRule("ServerName" & vbLf & "MailBox")
MsgBox "Call to function: " & lResult