Question

我有代码可以从Excel内将电子邮件发送到邮件组。

该组（* .msg Outlook联系人文件）位于共享驱动器文件夹中，并且会不断更新。

通常我会从Outlook的“人员”标签中手动删除群组联系人，然后将更新的文件拖到该标签中。

我可以自动从共享驱动器文件夹中加载联系人组，创建电子邮件，然后删除组联系人吗？

或者，我可以自动读取组联系人列表并将地址复制到“收件人”字段中，而无需将联系人组加载/删除到Outlook中吗？

Sub CreateReportEmail()
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    Dim BodyString As String
    BodyString = "Body of email"

    On Error Resume Next
    With OutMail
        .To = **MailingGroup**
        .Subject = "Bi-weekly report"
        .Body = "Body of email"
        .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Answer 1

听起来您有一个包含电子邮件预期收件人的文本文件。在这种情况下，您不必担心在Outlook中创建联系人组：您可以打开文件，提取收件人，然后将其添加到电子邮件的To中。我的建议是封装代码以获取您的收件人，因此您的最终代码可能看起来像这样：

    Sub CreateReportEmail()
        Dim OutApp As Object
        Dim OutMail As Object
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        Dim BodyString As String
        BodyString = "Body of email"

        On Error Resume Next
        With OutMail
            .To = GetMailingGroup
            .Subject = "Bi-weekly report"
            .Body = "Body of email"
            .Display
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    End Sub

 Function GetMailingGroup() As String
     Dim distList As Outlook.DistListItem
     Dim oApp As Outlook.Application
     Dim emailArray() As String
     Dim i As Integer

     Set oApp = Outlook.Application
     Set distList = oApp.CreateItemFromTemplate("\\nasfsu01\ReDirFold$\RedirectedFolders$\zthurst\Downloads\SHSC Member Services Bilingual Associates.msg")

     ReDim emailArray(1 To distList.MemberCount)

     For i = 1 To distList.MemberCount
        emailArray(i) = distList.GetMember(i).Address
     Next i

     GetMailingGroup = Join(emailArray, ";")
  End Function

如何将邮件发送到共享驱动器中保存的邮件组？

1 个答案: