Добавить CC и BCC с Mail Merge

Question

Я пытаюсь добавить функцию cc в слияние. Другими словами, мне нужно не только персонализировать электронные письма на разные адреса электронной почты. Я также хотел бы, чтобы каждое электронное письмо включало CC, который показывает одно и то же письмо нескольким получателям.

Пример: одно и то же письмо Джону Доу может быть автоматически отправлено его менеджеру.

Я попытался добавить, и; а также слияние двух ячеек в excel с адресами и ошибки.

Я также прочитал статью, в которой показано, как отправлять вложения нескольким получателям и изменять ее, чтобы сделать работу cc. См. Статью ниже.

http://word.mvps.org/FAQs/MailMerge/MergeWithAttachments.htm

код я придумал показано ниже. Это позволило мне cc, однако, он проходит только с первым рядом писем и ни с кем другим. Также тело сообщения не отображается.

Любые указатели?

Sub emailmergewithattachments() 

'Global Config Variables 
    Dim saveSent As Boolean, displayMsg As Boolean, attachBCC As Boolean 
    saveSent = True 'Saves a copy of the messages into the senders "sent" box 
    displayMsg = False 'Pulls up a copy of all messages to be sent - WARNING, do not use on long lists! 
    attachBCC = False 'Adds third column data into the BCC field. Will throw error if this column does not exist. 

    Dim Source As Document, Maillist As Document, TempDoc As Document 
    Dim Datarange As Range 
    Dim i As Long, j As Long 
    Dim bStarted As Boolean 
    Dim oOutlookApp As Outlook.Application 
'Dim oOutlookApp As Application 
    Dim oItem As Outlook.MailItem 
'Dim oItem As MailMessage 
    Dim mysubject As String, message As String, title As String 
    Set Source = ActiveDocument 
' Check if Outlook is running. If it is not, start Outlook 
    On Error Resume Next 
    Set oOutlookApp = GetObject(, "Outlook.Application") 
    If Err <> 0 Then 
     Set oOutlookApp = CreateObject("Outlook.Application") 
     bStarted = True 
    End If 
' Open the catalog mailmerge document 
    With Dialogs(wdDialogFileOpen) 
     .Show 
    End With 
    Set Maillist = ActiveDocument 
' Show an input box asking the user for the subject to be inserted into the email messages 
    message = "Enter the subject to be used for each email message." ' Set prompt. 
    title = " Email Subject Input" ' Set title. 
' Display message, title 
    mysubject = InputBox(message, title) 
' Iterate through the Sections of the Source document and the rows of the catalog mailmerge document, 
' extracting the information to be included in each email. 
    For j = 0 To Source.Sections.Count - 1 
     Set oItem = oOutlookApp.CreateItem(olMailItem) 

' modification begins here 

     With oItem 
      .Subject = mysubject 
.body = ActiveDocument.Content 
      .Body = Source.Sections(j).Range.Text 

      Set Datarange = Maillist.Tables(1).Cell(j, 1).Range 
      Datarange.End = Datarange.End - 1 
      .To = Datarange 

      Set Datarange = Maillist.Tables(1).Cell(j, 2).Range 
      Datarange.End = Datarange.End - 1 
      .CC = Datarange 

      If attachBCC Then 
       Set Datarange = Maillist.Tables(1).Cell(j, 3).Range 
       Datarange.End = Datarange.End - 1 
       .CC = Datarange 
      End If 

      For i = 2 To Maillist.Tables(1).Columns.Count 
       Set Datarange = Maillist.Tables(1).Cell(j, i).Range 
       Datarange.End = Datarange.End - 1 
       .Attachments.Add Trim(Datarange.Text), olByValue, 1 
       Next i 

       If displayMsg Then 
        .Display 
       End If 
       If saveSent Then 
        .SaveSentMessageFolder = mpf 
       End If 

       .Send 
      End With 
      Set oItem = Nothing 
      Next j 
      Maillist.Close wdDoNotSaveChanges 
' Close Outlook if it was started by this macro. 
      If bStarted Then 
       oOutlookApp.Quit 
      End If 
      MsgBox Source.Sections.Count - 1 & " messages have been sent." 
'Clean up 
      Set oOutlookApp = Nothing 
End Sub 

Answer 1

Во-первых, я бы выделил ваш код электронной почты и код для итерации вашей электронной таблицы. Вот мое взятие на код электронной почты для Outlook (убедитесь, что для настройки references-> объектной модели Outlook, так как я использовал раннее выжидать)

Sub SendMessage(recipients As Variant, subject As String, body As String, Optional ccRecips As Variant, Optional bccRecips As Variant, Optional DisplayMsg As Boolean, Optional AttachmentPath As Variant) 
      Dim objOutlook As Outlook.Application 
      Dim objOutlookMsg As Outlook.MailItem 
      Dim objOutlookRecip As Outlook.Recipient 
      Dim objOutlookAttach As Outlook.Attachment 
      Dim item As Variant 
      ' Create the Outlook session. 
      On Error Resume Next 
      Set objOutlook = GetObject(, "Outlook.Application") 
      If Err <> 0 Then 
       Set objOutlook = CreateObject("Outlook.Application") 
      End If 
      On error goto 0 

      ' Create the message. 
      Set objOutlookMsg = objOutlook.CreateItem(olMailItem) 

      With objOutlookMsg 
       ' Add the To recipient(s) to the message. 
       For Each item In recipients 
       Set objOutlookRecip = .recipients.Add(item) 
       objOutlookRecip.Type = olTo 
       Next 
       ' Add the CC recipient(s) to the message. 
       If Not IsMissing(ccRecips) Then 
       For Each item In ccRecips 
        Set objOutlookRecip = .recipients.Add(item) 
        objOutlookRecip.Type = olTo 
       Next 
       End If 
      ' Add the BCC recipient(s) to the message. 
       If Not IsMissing(bccRecips) Then 
       For Each item In bccRecips 
        Set objOutlookRecip = .recipients.Add(item) 
        objOutlookRecip.Type = olBCC 
       Next 
       End If 
      ' Set the Subject, Body, and Importance of the message. 
      .subject = subject 
      .body = body 'this can also be HTML, which is great if you want to improve the look of your email, but you must change the format to match 

      ' Add attachments to the message. 
      If Not IsMissing(AttachmentPath) Then 
       Set objOutlookAttach = .Attachments.Add(AttachmentPath) 
      End If 

      ' Resolve each Recipient's name -this may not be necessary if you have fully qualified addresses. 
      For Each objOutlookRecip In .recipients 
       objOutlookRecip.Resolve 
      Next 

      ' Should we display the message before sending? 
      If DisplayMsg Then 
       .Display 
      Else 
       .Save 
       .Send 
      End If 
      End With 
      Set objOutlook = Nothing 
End Sub 

Примечание: Получатели, КК и БЦК ожидают массивы значений , что также может быть единственным значением. Это означает, что мы, возможно, можем отправить ему необработанный диапазон, или мы можем загрузить этот диапазон в массив и отправить его.

Теперь, когда мы построили хороший общий способ отправки писем (которые удобно использовать повторно), мы можем думать о логике того, что мы отправляем по электронной почте. Я построил нижеследующее электронное письмо, но я не потратил на это много времени (или протестировал его, поскольку он весьма специфичен для ваших таблиц). Я считаю, что это должно быть очень близко.

При написании этого, я думаю, вы увидите основной трюк для редактирования своего собственного, однако - ключ разделил текст в ячейке CC, на разделитель, который вы используете. Это создает массив адресов, которые затем можно перебрать и добавить получателю, CC или BCC.

Sub DocumentSuperMailSenderMagicHopefully() 
Dim Source As Document, Maillist As Document, TempDoc As Document 
Dim mysubject As String, message As String, title As String 
Dim datarange As Range 'word range I'm guessing... 
Dim body As String 
Dim recips As Variant 
Dim ccs As Variant 
Dim bccs As Variant 
Dim j As Integer 
Dim attachs As Variant 
Set Source = ActiveDocument 
With Dialogs(wdDialogFileOpen) 'Hey, I'm not sure what this does, but I'm leaving it there. 
    .Show 
End With 
Set Maillist = ActiveDocument 
' Show an input box asking the user for the subject to be inserted into the email messages 
message = "Enter the subject to be used for each email message." ' Set prompt. 
title = " Email Subject Input" ' Set title. 
' Display message, title 
mysubject = InputBox(message, title) 
' Iterate through the Sections of the Source document and the rows of the catalog mailmerge document, 
' extracting the information to be included in each email. 

'IMPORTANT: This assumes your email addresses in the table are separated with commas! 
For j = 0 To Source.Sections.Count - 1 
    body = Source.Sections(j).Range.Text 
    'get to recipients from tables col 1 (I'd prefer this in excel, it's tables are much better!) 
    Set datarange = Maillist.tables(1).Cell(j, 1).Range 
    datarange.End = datarange.End - 1 
    recips = Split(datarange.Text) 
    'CC's 
    Set datarange = Maillist.tables(1).Cell(j, 2).Range 
    datarange.End = datarange.End - 1 
    ccs = Split(datarange.Text) 
    'BCC's 
    Set datarange = Maillist.tables(1).Cell(j, 3).Range 
    datarange.End = datarange.End - 1 
    bccs = Split(datarange.Text) 

    'Attachments array, should be paths, handled by the mail app, in an array 
    ReDim attachs(Maillist.tables(1).Columns.Count - 3) 'minus 2 because you start i at 2 and minus one more for option base 0 
    For i = 2 To Maillist.tables(1).Columns.Count 
     Set datarange = Maillist.tables(1).Cell(j, i).Range 
     datarange.End = datarange.End - 1 
     attachs(i) = Trim(datarange.Text) 
    Next i 

    'call the mail sender 
    SendMessage recips, subject, body, ccs, bccs, False, attachs 
    Next j 
Maillist.Close wdDoNotSaveChanges 
MsgBox Source.Sections.Count - 1 & " messages have been sent." 
End Sub 

Это превратилось в более длинный пост, чем я ожидал. Удачи с проектом!

Answer 2

У меня была такая же проблема, не имеющая возможности использовать CC, используя слияние электронной почты из Excel, а также захотела использовать поле BCC и иметь темы, которые являются переменными для каждого письма), а также не нашел хорошего инструмента, поэтому я создал свой собственный инструмент и только что выпустил его для других. Дайте мне знать, если это также решит вашу проблему: http://emailmerge.cc/

Он еще не обрабатывает вложения, но я планировал добавить это в ближайшее время.

EDIT: EmailMerge.cc теперь также обрабатывает вложения, высокий/низкий приоритет, прочтении [к сожалению, некоторые люди все еще хотят те;)]

Я надеюсь, что это полезно для вас, мои намерения не на спам SO;)