2014-09-04 2 views
2

편지 병합에 cc 함수를 추가하려고합니다. 즉, 이메일을 다른 이메일 주소로 맞춤 설정할 필요가 없습니다. 또한 각 이메일에 여러 수신자에게 동일한 이메일을 보여주는 CC가 포함되도록하고 싶습니다.편지 병합과 함께 CC 및 BCC 추가

예 : John Doe에게 보내는 동일한 이메일이 관리자에게 자동으로 전송 될 수 있습니다.

추가해 보았습니다. 두 셀을 병합하여 주소와 비교하고 오류가 발생합니다.

첨부 파일을 여러 수신자에게 보내는 방법과 첨부 파일을 수정하여 첨부 파일을 만드는 방법을 보여주는 기사도 읽었습니다. 아래 기사를 참조하십시오.

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

I는 다음과 같습니다 함께했다 코드입니다. 그것은 내가 전자 메일의 첫 번째 행과 나머지 중 하나만 통과하는 참조를 허용했다. 또한 메시지 본문이 표시되지 않습니다.

모든 포인터?

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 

답변

1

먼저 전자 메일 코드와 스프레드 시트 반복 코드를 구분합니다. CC의와 BCC의 값의 배열을 기대하고받는 사람 : 여기

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 

주의 사항 (일찍 명령을 행한다을 사용했습니다 같이 설정 references-> Outlook 개체 모델 확인) 전망에 대한 이메일 코드에 걸릴 내입니다 이 값은 단일 값일 수도 있습니다. 즉, 원시 범위를 보낼 수도 있고 배열에 해당 범위를로드하여 보낼 수도 있습니다.

우리는 전자 메일을 보내는 일반적인 방법을 만들었으므로 (우리는 재사용이 가능함) 전자 메일을 보내는 것에 대한 논리를 생각해 볼 수 있습니다. 나는 아래의 이메일을 만들었지 만, 테이블에 상당히 특수한 것처럼 많은 시간을 보냈거나 테스트하지 않았습니다. 나는 그것이 매우 가깝다고 생각한다.

이 글을 쓰면서 자신의 편집을위한 주요 트릭을 보게 될 것이라고 생각합니다. 핵심은 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 

이것은 예상보다 긴 게시물로 바뀌 었습니다. 프로젝트와 함께 행운을 빌어 요!

0

나는 Excel에서 편지 병합을 사용하여 CC를 할 수없는 동일한 문제가 있었고 숨은 참조 필드를 사용하고 각 이메일에 대한 변수가있는 주제를 갖고 싶었으며 좋은 도구도 찾지 못했습니다. 그래서 나는 내 도구를 만들었고 다른 사람들이 이익을 얻을 수 있도록 도구를 발표했습니다. 그것도 문제를 해결할 수 있는지 알려주세요. http://emailmerge.cc/

아직 첨부 파일을 처리하지는 않지만 곧 추가 할 예정입니다.

는 편집 : 나는이 당신에게 유용 희망

, 내 의도는 스팸에하지 않는 것입니다 EmailMerge.cc는 이제 첨부 파일, 높은/낮은 우선 순위를 처리, 영수증 [) 불행하게도 어떤 사람들은 여전히 ​​그 원하는]를 읽을 수 SO;)

관련 문제