Cách truy cập các nhóm liên lạc trong Excel VBA?

Question

Tôi đang xây dựng một bổ trợ Excel gửi sổ làm việc hoạt động dưới dạng tệp đính kèm trong mẫu email Outlook đến một Nhóm Liên hệ cụ thể.

Tôi đã nhận hai phần đầu tiên để làm việc với mã bên dưới, nhưng tôi không chắc chắn cách đặt trường .TO thành nhóm liên hệ.

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 

Answer 1

Chỉ cần sử dụng tên của nhóm liên hệ (trước đây gọi là "danh sách phân phối"). Tôi vừa thử nó, như được đề xuất trên trang web Ron de Bruin's và nó hoạt động.

Answer 2

Để địa chỉ email hoặc tên người nhận được giải quyết (để chúng không hiển thị văn bản thuần túy), bạn có thể thực hiện các thao tác sau.

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