If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Add CC addresses in Macro Merge
Hello,
I use the macro below to create and send an HTML email merge with attachments. It references a directory that stores the To email address and attachment link. I would like to cc 2 other people on each email and hope someone can help me with the code. If a dialogue box simply asked who should be cc'd, that would be fine (as long as I can enter multiple addresses). Thanks very much! Sub emailmergewithattachments() 'To create the email messages in HTML format 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 oItem As Outlook.MailItem 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 = 1 To source.Sections.Count source.Sections(j).Range.Copy Set oItem = oOutlookApp.CreateItem(olMailItem) With oItem .Subject = mysubject .BodyFormat = olFormatHTML .Display Set objDoc = .GetInspector.WordEditor Set objSel = objDoc.Windows(1).Selection objSel.Paste Set datarange = Maillist.Tables(1).Cell(j, 1).Range datarange.End = datarange.End - 1 .To = datarange 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 .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 & " messages have been sent." 'Clean up Set oOutlookApp = Nothing End Sub |
#2
|
|||
|
|||
Add CC addresses in Macro Merge
|
Thread Tools | |
Display Modes | |
|
|