我正在尝试在适用于Outlook 2016的VBA脚本上满足以下条件。
我希望用户在向外部用户发送电子邮件时弹出窗口进行确认。我还希望用户在向内部和外部用户发送电子邮件时获得弹出确认。
以下是代码,但是我无法找出解决方法,因为ElseIf
似乎被忽略了。
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 Long
Dim external As Long
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 = 1
If str1 <> strMyDomain Then external = 1
Next
If external = 1 Then
prompt = "This email is being sent to External addresses. Do you still wish to send?"
If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
ElseIf internal + external = 2 Then
prompt = "This email is being sent to Internal and External addresses. Do you still wish to send?"
If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
End If
End If
End If
End Sub
遵循正确的代码
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. Do you still wish to send?"
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. Do you still wish to send?"
If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
End If
End If
End Sub
这很好用,可以匹配我需要的所有选项。在bolean中修改了字符串。感谢大家的支持。
本文收集自互联网,转载请注明来源。
如有侵权,请联系 [email protected] 删除。
我来说两句