向 Outlook 组发送电子邮件，不包括一个人

Question

我有一个 Access 数据库，我们通过它通过电子邮件将报告发送到 Outlook 电子邮件地址列表。此列表包含电子邮件组。

我希望能够以编程方式向群组发送电子邮件，但不向群组的特定成员发送电子邮件。

很遗憾，此人无法从群组中删除，因为他仍然需要能够接收其他部门通过群组电子邮件发送给他的电子邮件。

此外，我不能简单地将组拆分为组成部分，因为每次将新成员添加到 Outlook 组时，我都无法继续向脚本添加电子邮件。

谁能建议一种方法来狙击发送到 Outlook 组中这个特定地址的电子邮件？

我更喜欢 VBA 解决方案，但也可以使用 PowerShell 来实现。

编辑 - 这是我目前的代码。

这是发送电子邮件的函数：

Function SendEmails(SystemID As String, _
                    DistributionGROUPID As String, _
                    subjectID As String, _
                    EmailIDBody As String, _
                    Optional Attachments As Variant)

    Dim Subject As String
    Dim SendTo As Variant
    Dim CopyTo As Variant
    Dim BlindCopyTo As Variant
    Dim ReplyTo As Variant
    Dim emailBody As String
    Dim Attachement As Variant

    Subject = GetEmailSubject(SystemID, subjectID)
    SendTo = GetEmailAddresses(SystemID, DistributionGROUPID, 1)
    CopyTo = GetEmailAddresses(SystemID, DistributionGROUPID, 2)
    BlindCopyTo = GetEmailAddresses(SystemID, DistributionGROUPID, 3)
    ReplyTo = GetEmailAddresses(SystemID, DistributionGROUPID, 4)
    emailBody = GetEmailBody(SystemID, EmailIDBody)

    If IsArray(Attachments) Then
        Attachement = Attachments
    End If

    ' Call Send Email
    SendMails _
        Subject, _
        Attachement, _
        SendTo, _
        CopyTo, _
        BlindCopyTo, _
        ReplyTo, _
        emailBody

End Function

这是从 Access 表中获取电子邮件地址并将其加载到字符串中的函数。我添加了一条评论，显示我可以在哪里插入一些代码/对一个函数的引用，该函数将打开每个电子邮件地址并确定它是否是一个组。 致那些知道自己在做什么的人 - 这是正确的方法，还是有可能？我会做一些谷歌搜索并尝试偶然发现，但如果有人可以提供解决方案，将不胜感激。

Function GetEmailAddresses(SystemID As String, Business As String, RecipientType As Integer) As Variant

    Dim arr() As String
    Dim lSubject As String
    Dim qdf As QueryDef
    Set qdf = CurrentDb().QueryDefs("qry_Email_Get_Email_Addresses")

    qdf.Parameters(0) = SystemID
    qdf.Parameters(1) = Business
    qdf.Parameters(2) = CDbl(RecipientType)

    Dim RS As Recordset
    Set RS = qdf.OpenRecordset

    If RS.RecordCount = 0 Then

        ReDim arr(1)
        arr(0) = ""

    Else

        RS.MoveLast
        ReDim arr(RS.RecordCount - 1)
        RS.MoveFirst
        Dim offset As Integer
        offset = 0
        Do While Not RS.EOF
        ' change here? open up outlook object, determine if email is a group.
        ' if group, then create inner loop that adds individual emails to 'arr' array, excluding specific address.
            arr(offset) = RS![Email_Address]
            offset = offset + 1
            RS.MoveNext
        Loop

    End If

    RS.Close
    Set RS = Nothing

    GetEmailAddresses = arr

End Function

Answer 1

您可以遍历 AddressEntry.Members 集合并一次只添加您想要的成员，而不是发送到整个 DL。