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

Question

我是 VBA 编码的新手。我正在尝试在 Outlook 中创建规则，但它不起作用。我需要的工作过程是 1.Detect subject mail = Approve.,2.Detect body mail = Approve.3.Detect sender E-mail and final Send E-mail to我的目标电子邮件。

我尝试通过使用回复脚本来使用发送邮件的 python 脚本，但它不起作用并尝试使用 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

标签： vbaoutlook

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