根据清单发送电子邮件之前提示用户

Question

我在发送学校电子邮件时尝试验证电子邮件地址。

学生电子邮件地址的格式：[电子邮件受保护]。
学生姓氏的末尾有两个数字（这是他们的年级）。

我已阅读这篇文章（Outlook VBA 验证收件人）。

黑名单可以基于字符串而不是完整的电子邮件地址吗？
因此，如果它包含：[电子邮件受保护]，它将警告用户这是学生电子邮件地址。
会有多种变体，例如 26@、27@ 等等。

我还希望在同一个 VBA 脚本中提示用户是否是外部电子邮件地址（@gmail.com、@hotmail.com 等），其原理与上述收件人的电子邮件地址包含特定文本字符串的原理相同。

向学生或外部地址发送电子邮件时，学校工作人员应收到提示。
此外，提示还应列出触发提示的电子邮件地址。

Answer 1

InStr

会将部分地址视为完整地址。

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

    Dim myRecipients As Recipients
    Dim recip As Recipient
    Dim i
    Dim prompt As String
    
    Dim internalDomain As String
    internalDomain = "@schooldomain.com"
    
    Dim Checklist As String
    Checklist = "[email protected]" & _
                "[email protected]" & _
                "[email protected]" & _
                "[email protected]" & _
                "[email protected]" & _
                "[email protected]" & _
                "[email protected]" & _
                "[email protected]" & _
                "[email protected]" & _
                "[email protected]"
    
    Set myRecipients = Item.Recipients
    
    For i = myRecipients.count To 1 Step -1
    
        Set recip = myRecipients.Item(i)
        
        Debug.Print
        Debug.Print "recip.........: " & recip          ' may not be in the form of an address
        Debug.Print "recip.Name....: " & recip.Name
        Debug.Print "recip.Address.: " & recip.Address
        
        If InStr(LCase(recip.Address), LCase(internalDomain)) > 0 Then
        
            Dim atPos As Long
            atPos = InStrRev(recip.Address, internalDomain)
            
            ' Determine partial address starting one character before "@"
            Dim recipAddrEnd As String
            recipAddrEnd = Right(recip.Address, atPos - 3)
            Debug.Print recipAddrEnd
            
            Dim warningList As String
            
            If InStr(LCase(Checklist), LCase(recipAddrEnd)) Then
                Debug.Print "Student address"
                Debug.Print recip.Address
                warningList = warningList & recip.Address & vbCr
                
            Else
                Debug.Print "Internal non-student address"
            End If
            
        Else
            Debug.Print "External address or not in SMTP format."
            Debug.Print recip.Address
            warningList = warningList & recip.Address & vbCr
        
        End If
        
    Next i
    
    If warningList <> "" Then
        prompt = "Sending to:" & vbCr & vbCr & warningList & vbCr & "Are you sure?"
        
        Dim vButtons As Long
        vButtons = vbYesNo + vbQuestion + vbMsgBoxSetForeground + vbDefaultButton2
        If MsgBox(prompt, vButtons, "Check Address") = vbNo Then
            Cancel = True
        End If
    End If

End Sub