Question

我想让我的VBA在每次尝试向网上论坛发送电子邮件时都要求我确认。

我想出了以下代码，该代码非常有用，但仅适用于向人发送电子邮件：

Option Explicit

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

Dim prompt As String
On Error Resume Next

   Select Case LCase(Item.To)
      Case "alias@gmail.com" ' , "alias2@domain3.com", "alias3@domain3.com"

        prompt = "You are sending this to " & Item.To & ". Are you sure you want to send the Mail?"
            If MsgBox(prompt, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
                Cancel = True
            End If

      Case Else

        Item.Send

   End Select

End Sub

但是，我无法通过创建的联系人组更改“ alias@gmail.com”。是否可以输入组而不是电子邮件地址？如果是，怎么办？

“我的最终目标”是仅在某些密件抄送中将其发送给某些组。

注意：我发现，如果我将电子邮件发送到包含一个（单个）电子邮件地址 alias@gmail.com 的组，则上述代码将无法使用Outlook识别组

Answer 1

您将需要遍历MailItem.Recipients集合中的Recipient对象。然后从每个收件人中获取Recipient.AddressEntry对象，并查看AddressEntry.AddressEntryUserType = olOutlookDistributionListAddressEntry。这将告诉您是否是Outlook联系人组（DL）。

Answer 2

我想出了自己的答案：

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

Dim prompt As String
Dim GROUP1 As String
Dim GROUP2 As String

GROUP1 = "GROUP of People"
GROUP2 = "personx@yahoo.com"

    If InStr(Item.To, GROUP1) > 0 Or InStr(Item.To, GROUP2) Then
        prompt = "This Email is sent to the wrong person/Groups in .To"
            MsgBox (prompt)
            Cancel = True

    End If

    If InStr(Item.CC, GROUP1) > 0 Or InStr(Item.CC, GROUP2) Then
        prompt = "This Email is sent to the wrong person/Groups in .Cc"
            MsgBox (prompt)
            Cancel = True
    End If


End Sub

如果我在代码顶部写的任何组或个人都在收件人中，这将使我停止。但是，如果他们在密件抄送中，它就可以工作。

Outlook VBA：如何阻止发送到.To和.Cc中的组的电子邮件

2 个答案: