问使用VBA遍历电子邮件收件人并对照一系列域进行检查

EN

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Dim addrRecips As Outlook.Recipients
    Dim addrRecip As Outlook.Recipient
    Dim arrDomain As Variant
    Dim pa As Outlook.PropertyAccessor
    Dim recipDomain As String
    Dim subjSecure As String

    Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    Set addrRecips = Item.Recipients

    ' Set up the array
    arrDomain = Array("domain1.com", "domain2.com", "domain3.com", "domain4.net")

    For Each addrRecip In addrRecips
        Set pa = addrRecip.PropertyAccessor

        ' Get the domain from the current recipient's email address
        recipDomain = Split(pa.GetProperty(PR_SMTP_ADDRESS), "@", 2, vbTextCompare)(1)
        Debug.Print recipDomain

        ' Check if the recipient's email domain is in the array of domains
        If IsInArray(recipDomain, arrDomain) = False Then
            Debug.Print "Recipient domain, " & recipDomain & ", is in array of domains"

            ' Current recipient's email domain is not in the list, so add " zsecure" to the subject
            subjSecure = Item.Subject & " zsecure"
            Item.Subject = subjSecure

            ' If any of the recipients' domains is not in the list, we can stop here and send the email
            Exit Sub
        End If
    Next

End Sub