如何使用VBA运行Outlook的规则？

Question

我是VBA编码的新手。我试图在Outlook中创建规则，但它不起作用。我需要的工作流程是1.检测主题邮件=批准。，2.检测正文邮件=批准。3.检测发件人电子邮件并最终将电子邮件发送到我的目标电子邮件。

我试图通过使用回复脚本来使用send-mail的python scrip，但它不起作用，并尝试使用VBA，找到了许多解决方案，但它也不起作用。请帮帮我。

这是我的代码：

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")
Dim oPA As Outlook.PropertyAccessor
Dim oContact As Outlook.ContactItem
Dim oSender As Outlook.AddressEntry
'==default local Inbox====================================================
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
'MsgBox ("Request for ID Document")
End Sub
Public Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim xEmployer As String
Dim xLine As String
Dim xMessage As String
Dim SenderID As String
Dim SenderEmail As String
Dim xBy As String
Dim xEmail As String
Dim xFunc As Boolean
Dim xRunFile As String
Dim olAddrList      As AddressList
Dim olAddrEntry     As AddressEntry
Dim olExchgnUser    As ExchangeUser
If TypeName(item) = "MailItem" Then
'=========================================================================
Set Msg = item
Set oPA = Msg.PropertyAccessor
SenderID = oPA.BinaryToString _
(oPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0C190102"))
'Obtain AddressEntry Object of the sender
Set oSender = Application.Session.GetAddressEntryFromID(SenderID)
SenderEmail = oSender.Address
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(0)
Dim OL              As Object
Dim EmailItem       As Object
Dim StrFileName     As String
If (InStr(UCase(Msg.body), "Approve") > 0) And _
(InStr(UCase(Msg.subject), "Approve") > 0) And _
((InStr(UCase(Msg.SenderEmailAddress), "CFGFIN006") > 0)) Then
With EmailItem
.subject = "AP_Subject"
.body = "AP_Body"
.To = "[e-mail]"
.CC = ""
.BCC = ""
.Importance = 1
.Send
End With
Set Doc = Nothing
Set EmailItem = Nothing
Set OL = Nothing
SendMail = True
End If
End sub

Answer 1

在比较文本时要更加小心。

Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
Private WithEvents defInboxItems As Items
Private Sub Application_Startup()
Dim defInboxItems As Items
'== default local Inbox items ===================================
Set defInboxItems = Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Public Sub defInboxItems_ItemAdd(ByVal Item As Object)
Dim msg As MailItem
Dim oPA As propertyAccessor
Dim SenderID As String
Dim oSender As AddressEntry
Dim SenderEmail As String
Dim EmailItem As MailItem
If TypeName(Item) = "MailItem" Then
Set msg = Item
Set oPA = msg.propertyAccessor
SenderID = oPA.BinaryToString(oPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0C190102"))
'Obtain AddressEntry Object of the sender
Set oSender = Session.GetAddressEntryFromID(SenderID)
SenderEmail = oSender.Address
Debug.Print " SenderEmail: " & SenderEmail
' Break If conditions to more readily see where a problem, if any, occurs
If InStr(UCase(msg.Body), ("APPROVE")) > 0 Then
' You can use UCase / LCase on everything
If InStr(UCase(msg.Subject), UCase("Approve")) > 0 Then
' You can use vbTextCompare
If InStr(UCase(msg.SenderEmailAddress), "CFGFIN006", vbTextCompare) > 0 Then
Set EmailItem = CreateItem(olMailItem)
With EmailItem
.Subject = "AP_Subject"
' ...
.Display
End With
End If
End If
End If
End If
End Sub