Question

我有一个Access DB，通过它我们可以将报告通过电子邮件发送到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。

发送电子邮件给Outlook组排除一个人

1 个答案: