Question

此Outlook宏尝试发送由第三方软件生成的大量电子邮件。如果应该过滤“黑名单”电子邮件并关闭它们以及“忽略列出”电子邮件，而对它们不执行任何操作（供用户添加注释等）

我遇到了问题，因为有时宏无法接收电子邮件收件人（通常，如果一个人在其他软件上生成所有电子邮件），并且不要单击其中一封电子邮件，而只是运行宏...没有接听收件人，它与黑色不匹配，因此会正确忽略列表。

关于如何解决它的任何想法？非常感谢

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

Outlook VBA宏-忽略收件人

0 个答案: