如何访问Excel VBA中的联系人组?

时间:2012-04-06 21:22:35

标签: excel vba excel-vba outlook

我正在构建一个Excel加载项,将活动工作簿作为Outlook电子邮件模板中的附件发送到特定联系人组。

我已经获得了使用下面代码的前两部分,但我不确定如何将.TO字段设置为联系人组。

Public Sub Mail_Reports()
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object 

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    On Error Resume Next

    Set OutApp = CreateObject("Outlook.Application")

    'Set this line to the path and file name of your template
    Set OutMail = OutApp.CreateItemFromTemplate("C:\Users\moses\AppData\Roaming\Microsoft\Templates\test.oft")
    On Error Resume Next

    With OutMail
        '.TO field should be set to the contact group
        .BCC = ""
        .Attachments.Add ActiveWorkbook.FullName
        .HTMLBody = Replace(OutMail.HTMLBody, strOldPeriod, strNewPeriod)
        .Subject = Replace(OutMail.Subject, strOldPeriod, strNewPeriod)
        'To display the email leave as is;  to send the Email, change to .Send
        .Display    'or Send
    End With

    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

2 个答案:

答案 0 :(得分:3)

只需使用联系人组的名称(以前称为“分发列表”)。我刚刚按照Ron de Bruin's网站上的建议尝试了它,它确实有效。

答案 1 :(得分:0)

为了解析收件人的电子邮件地址或名称(因此它们不显示纯文本),您可以执行以下操作。

With OutMail
    '.TO field should be set to the contact group
    .BCC = ""
    .Attachments.Add ActiveWorkbook.FullName
    .HTMLBody = Replace(OutMail.HTMLBody, strOldPeriod, strNewPeriod)
    .Subject = Replace(OutMail.Subject, strOldPeriod, strNewPeriod)
    'To display the email leave as is;  to send the Email, change to .Send
    .Display    'or Send
    If Not .Recipients.ResolveAll Then
        For Each Recipient In .Recipients
            If Not Recipient.Resolved Then
                MsgBox Recipient.Name & " could not be resolved"
            End If
        Next 
    End If
End With