如何根据复选框填充电子邮件收件人/抄送字段

Question

我正在使用 Excel VBA 根据我们每天早上填充的数据表自动生成一组每天发送的电子邮件。

根据邮件内容，接收邮件的人员也会发生变化。
可以将个人分组（例如 IT、财务、人力资源……），但有一些小的重叠。

我的想法是为每个组创建一个复选框，以便当天生成电子邮件的任何人都可以勾选这些组并将其填充到“收件人”或“抄送”字段。

我最初想使用基于链接的 True/False 复选框单元格的公式，但这很快就会变得混乱，并且不允许我同时添加多个组。

我的下一个想法是创建一个表，其中每个人都有一行，有一列标识他们各自的组，但我不确定从哪里开始填充“收件人”/“抄送”字段。

我添加了宏来生成下面的电子邮件。我希望得到一些正确方向的指示。

Sub SendEmail_Test()

Dim EmailApp As Outlook.Application
Dim NewEmaiItem As Outlook.MailItem
Set EmailApp = New Outlook.Application
Set NewEmailItem = EmailApp.CreateItem(olMailItem)

NewEmailItem.To = "[email protected]"
NewEmailItem.CC = "[email protected]"
NewEmailItem.Subject = Format(Date, "mmmm dd") & " info: Subject"
NewEmailItem.Display True

End Sub

截图：

Answer 1

由于电子邮件地址显示在复选框右侧的第一列中（而不是在复选框的标签中），因此您需要找到每个复选框的

TopLeftCell

属性。

注 1： 这假设您使用的是表单控件复选框而不是 ActiveX 复选框。

注 2： 在此图像中，

TopLeftCell

位于 B2 中，因为控制手柄位于 B2 中，而实际的复选框似乎位于 B3 中。

我添加了第三列复选框，以显示如何在多列中查找您的抄送地址。
我还包含了一些 With 语句 ，因为它稍微缩短了代码。

Sub SendEmail_Test()

    Dim EmailApp As Outlook.Application
    Set EmailApp = New Outlook.Application
    
    Dim NewEmailItem As Outlook.MailItem
    Set NewEmailItem = EmailApp.CreateItem(olMailItem)
    
    Dim ToField As String
    Dim CCField As String
    
    Dim chkBox As CheckBox  
    'Look at each checkbox on the sheet in turn.
    For Each chkBox In ThisWorkbook.Worksheets("Sheet1").CheckBoxes
        With chkBox.TopLeftCell
            If chkBox.Value = 1 Then
                Select Case .Column 'Look at the TopLeftCell.Column property.
                    Case 2 'Column B contains TO address checkboxes.
                        ToField = ToField & chkBox.TopLeftCell.Offset(, 1) & "; "
                    Case 5, 8 'Column E & H contains CC
                        CCField = CCField & chkBox.TopLeftCell.Offset(, 1) & "; "
                End Select
            End If
        End With
    Next chkBox
    'Remove the last semicolon for each string.
    If Len(ToField) > 0 Then ToField = Left(ToField, Len(ToField) - 2)
    If Len(CCField) > 0 Then CCField = Left(CCField, Len(CCField) - 2)
    
    With NewEmailItem
        .To = ToField
        .CC = CCField
        .Subject = Format(Date, "mmmm dd") & " info: Subject"
        .Display True
    End With

End Sub

在您发布的代码中，您使用了

NewEmailItem

，但声明了

NewEmaiItem

。使用

Option Explicit

时，这会在编译时导致 Variable not Defined 错误。
工具 > 选项 > 需要变量声明 会将 Option Explicit 置于所有新模块的顶部。

编辑：刚刚重新阅读了你的问题。当您谈论组时，您指的是Outlook 联系人组吗？如果没有，请添加您的电子邮件组表的模型。