Mailmerge macro produces empty email after 200 emails created

Question

I've been playing with this macro for days now and when I thought it was working well I discovered that it works properly only with the first 200 emails. After that, it creates emails with proper recipient and subject, but no text and no attachments. After testing different scenarios, it seems that (some kind) of Outlook memory gets filled, but I don't know what and how to clear it ( i added oItem and oOutlookApp = nothing without success). The only way I can get it to work is if I close Outlook and run the macro again with the 200 and following emails. Any ideas? thanks

EDITS: 1- I also tried clear the clipboard at the end of the loop using the accepted answer overhere, alas with no result.

2- I found this answer that seems related to my problem. Two major differences though: my macro runs from Word to Outlook (not Outlook to Excel) and I don't get an error message; emails beyond #200 are simply created empty. So i don't know if/how it can be of help here.

3- Following niton's remark, there is now an error message. Progess I guess...

The highlighted line is

.Attachments.Add Trim(Datarange.Text), olByValue, 1 

And it does that on the 200th email.

' MailMerge Macro
'
'
Sub MergeWithAttachments()
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
Dim mailWord As Object
Dim oData As New DataObject


    Set Source = ActiveDocument
    ' Check if Outlook is running.  If it is not, start Outlook
    On Error Resume Next
    Set oOutlookApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    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.
If MsgBox("Are you adding cc email recipients?", vbYesNo, "CC email") = vbYes Then
    If MsgBox("Are your cc email recipients in the second column from the left?", vbYesNo, "CC in second column") = vbYes Then
        GoTo Add_cc
        Else:
        If MsgBox("Cc email recipients need to be in the second column. Please rework your directory accordingly.", vbOKOnly, "Cancelling Mail Merge") = vbOK Then
        Exit Sub
        End If
No_cc:

For j = 1 To Source.Sections.Count - 1

    Source.Sections(j).Range.Copy
    Set oItem = oOutlookApp.CreateItem(olMailItem)
    Set mailWord = oItem.GetInspector.WordEditor

    With oItem
        .Subject = mysubject
        mailWord.Range.PasteAndFormat (wdFormatOriginalFormatting)
        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

GoTo Merge_finished

Add_cc:
For j = 1 To Source.Sections.Count - 1

    Set oItem = oOutlookApp.CreateItem(olMailItem)

    With oItem
        .Subject = mysubject
        Set Datarange = Maillist.Tables(1).Cell(j, 1).Range
        Datarange.End = Datarange.End - 1
        .To = Datarange
        'code for adding cc emails. Currenlty set to read column 2 as cc emails
        Set Datarange = Maillist.Tables(1).Cell(j, 2).Range
        Datarange.End = Datarange.End - 1
        .CC = Datarange.Text
        Source.Sections(j).Range.Copy
        Set mailWord = oItem.GetInspector.WordEditor
        mailWord.Range.PasteAndFormat (wdFormatOriginalFormatting)

        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

Merge_finished:
End If
Else: GoTo No_cc
End If

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

You may be running into this. Outlook macro runs through 250 iterations before failing with error

https://support.microsoft.com/en-us/kb/830836

"This issue occurs because of a limit on the number of items that clients can open. By default, this limit is set to 100 for attachments and 250 for messages."

Your limit could be set to 200. If you cannot fix this, if the cause, try changing your code. Mark processed items or moving them, with a down counting loop starting at 200. Close Outlook after 200 items are processed. Reopen and process the remainder 200 at a time.