VBA脚本可防止用户通过电子邮件发送错误的电子邮件地址

时间:2018-11-28 12:59:15

标签: vba outlook office365

我一直在寻找一种防止用户错误发送电子邮件的方法,并且发现了一个可以正常工作的脚本,但是如果有人可以帮助我,我想在弹出消息中添加一些复选框选项, >

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim pa As Outlook.PropertyAccessor
    Dim prompt As String
    Dim Address As String
    Dim lLen
    Dim strMyDomain
    Dim internal As Boolean
    Dim external As Boolean

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

    ' non-exchange
    ' userAddress = Session.CurrentUser.Address
    ' use for exchange accounts
    UserAddress = Session.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress
    lLen = Len(UserAddress) - InStrRev(UserAddress, "@")
    strMyDomain = Right(UserAddress, lLen)

    Set recips = Item.Recipients

    For Each recip In recips
        Set pa = recip.PropertyAccessor

        Address = LCase(pa.GetProperty(PR_SMTP_ADDRESS))
        lLen = Len(Address) - InStrRev(Address, "@")
        str1 = Right(Address, lLen)

        If str1 = strMyDomain Then internal = True
        If str1 <> strMyDomain Then external = True
    Next



    If external And Not internal Then
        prompt = "This email is being sent to External addresses. HAVE YOU CHECKED THE RECIPIENT ADDRESS IS CORRECT? Do you still wish to send the email?"

        If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
            Cancel = True
        End If

    ElseIf internal And external Then
        prompt = "This email is being sent to Internal and External addresses. HAVE YOU CHECKED THE RECIPIENT ADDRESS IS CORRECT? Do you still wish to send the email?"

        If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
            Cancel = True
        End If

    End If
End Sub

我想做的是在脚本中添加一些复选框,因此在弹出消息中,必须选中一些复选框,然后才能启用“是”并可以发送电子邮件

要添加的复选框为:

  • 电子邮件是否已加密(仅在发送附件时)
  • 您是否已检查收件人正确(仅用于外部电子邮件)
  • 您是否已检查附件是否正确(仅当存在 附件已附加)

Example of POPUP MESSAGE

0 个答案:

没有答案