我一直在寻找一种防止用户错误发送电子邮件的方法,并且发现了一个可以正常工作的脚本,但是如果有人可以帮助我,我想在弹出消息中添加一些复选框选项,
>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
我想做的是在脚本中添加一些复选框,因此在弹出消息中,必须选中一些复选框,然后才能启用“是”并可以发送电子邮件
要添加的复选框为: