vba - Outlook 2003 VB 脚本创建转发规则

Question

您好，有谁知道如何创建一个将在 Outlook 2003 中添加规则的 VB 脚本，这样如果我收到来自用户 PersonA@mail.com 的电子邮件，它将将该电子邮件转发到 PersonB@mail.com。

我还想知道是否可以创建一个 VB 脚本来删除以前创建的规则。

我做了一些研究，似乎可以创建一个宏来执行此操作，但我完全迷失了，因为我不熟悉我需要编辑的对象或拥有任何类型的 API。

也许我必须创建一个宏来添加规则，这使用一个 VB 脚本来触发宏。

Answer 1

我会改用直接的VBA。ItemAdd 事件可用于检查默认收件箱中的传入消息并转发它们。如果您需要更改转发，编辑电子邮件地址很简单。

前任：

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

此代码应放在 ThisOutlookSession 模块中，然后您必须重新启动 Outlook。如果您需要放置帮助，请参阅我在哪里放置 Outlook VBA 代码？