Versenden einer Mail mit 3 Anhängen als Serienbrief

Sub emailmergewithattachments()

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 - 1
    Set oItem = oOutlookApp.CreateItem(olMailItem)
    With oItem
        .Subject = mysubject
        .Body = Source.Sections(j).Range.Text
        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 - 1 & " messages have been sent."  

'Clean up  
Set oOutlookApp = Nothing

End Sub