Как запустить правила Outlook с VBA?

Question

Я новичок ie в кодировании VBA. Я пытаюсь создать правила в Outlook, но это не работает. Мне нужен рабочий процесс: 1. Определить тему письма = Одобрить. мой целевой E-mail.

Я пытаюсь использовать сценарий отправки почты 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 = "my_manager_name@example.com"
    .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