Макрос Outlook VBA - игнорирование получателя - PullRequest
0 голосов
/ 22 марта 2019

Этот макрос Outlook пытается отправить банку электронной почты, созданной сторонним программным обеспечением.Если нужно отфильтровать электронные письма «черного списка» и просто закрыть их, а также «игнорировать перечисленные» электронные письма и ничего не делать с ними (чтобы пользователь мог добавлять заметки и т. Д.)

У меня проблема, так как иногда макрос не 't забрать получателя электронной почты (обычно, если генерируются все электронные письма в другом программном обеспечении), не нажимать на одно из этих писем и просто запускать макрос ... Не поднимая получателя, он не совпадает с черным и игнорируетсписок правильно.

Есть идеи как это исправить?Высоко ценится

Sub BatchSendOutAllOpenEmailsTEST()
    Dim objInspectors As Outlook.Inspectors
    Dim i As Long
    Dim objMail As Outlook.MailItem
    Dim lMailCount As Long

Dim arr_Blacklist As Variant, arr_IgnoreList As Variant
Dim str_Blacklist As String, str_IgnoreList As String
Dim Blacklist As Integer, Ignorelist As Integer

'Blacklisted domains emails are closed and not saved
str_Blacklist = "blockemail1.com.au,blockemail2.com.au,blockemail3.com.au"
arr_Blacklist = Split(str_Blacklist, ",")

'IgnoreList domains emails are ignored and email left open
str_IgnoreList = "ignoreemail1.com.au,ignoreemail2.com.au,ignoreemail3.com.au"
arr_IgnoreList = Split(str_IgnoreList, ",")

    'Get all open items in your Outlook
    Set objInspectors = Outlook.Application.Inspectors

    lMailCount = 0
    For i = objInspectors.Count To 1 Step -1
        If objInspectors.Item(i).CurrentItem.Class = olMail Then
           'Get all open emails
           Set objMail = objInspectors.Item(i).CurrentItem

                'start blacklist checking
                Set recip = objMail.Recipients

                For Each recip In objMail.Recipients
                    'str1 = "" ' clear domain variable
                    Address = recip.Address
                        lLen = Len(Address) - InStrRev(Address, "@") 'get domains
                        str1 = Right(Address, lLen)
                        Debug.Print Address & " - " & str1

                            'detect emails on blacklist
                            Blacklist = 0 'clear out blacklist
                            For b = LBound(arr_Blacklist) To UBound(arr_Blacklist)
                            Debug.Print "checking: "; str1; " against: "; arr_Blacklist(b)
                                If arr_Blacklist(b) = str1 Then
                                    Blacklist = Blacklist + 1
                                End If
                            Next b

                            'detect emails on ignorelist
                            Ignorelist = 0 'clear out Ignorelist
                            For ig = LBound(arr_IgnoreList) To UBound(arr_IgnoreList)
                            Debug.Print "checking: "; str1; " against: "; arr_IgnoreList(ig)
                                If arr_IgnoreList(ig) = str1 Then
                                    Ignorelist = Ignorelist + 1
                                End If
                            Next ig
                 Next
                 Debug.Print str1; " BL quant: "; Blacklist & " - IG quant: "; Ignorelist
                 'end blacklist checking

'            If objMail.Subject <> "" Then
                If objMail.Recipients.Count = 0 Or Blacklist > 0 Then
                    objMail.Close (olDiscard) 'close email without saving
                    Debug.Print str1; " closed"
                ElseIf Ignorelist = 0 Then
                    objMail.Send
                    lMailCount = lMailCount + 1
                    Debug.Print str1; " Sent"
                Else
                    Debug.Print str1; " Ignored"
                End If
'            End If
        End If
        str1 = "" ' clear domain variable
    Next

    'Prompt you of the results
    MsgBox lMailCount & " open emails have been sent out!", vbInformation + vbOKOnly
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...