Afdruk samenvoegen, afzonderlijke documenten naam meegeven

Sub Splitter()
'------------------------------------------------------------------------------------------------------------------
' splitter Macro
' Macro created by Doug Robbins to save each letter created by a mailmerge as a separate file.
' Adapted by OctaFish to extend Filename with 8th paragraph
'------------------------------------------------------------------------------------------------------------------
Dim Letters As Integer, Counter As Integer
Dim DocName As String, sRange As String
Dim Pad As String, sNullen As String
Dim aRange As Range
Dim aDoc As Document, aDocNew As Document
[B]Dim tmp As Variant[/B]

    DocName = "Recept "
    Pad = "H:\Temp\Word\"
    
    Set aDoc = ActiveDocument
    Letters = aDoc.Sections.Count
    For Counter = 1 To Len(Letters)
        sNullen = sNullen & "0"
    Next Counter
    sNullen = sNullen & "0"
    
    Selection.HomeKey Unit:=wdStory
    Counter = 1
    While Counter < Letters
        '-----------------------------------------------------------------------------------------------
        'Naam samenstellen op basis van nummering
        '-----------------------------------------------------------------------------------------------
        DocName = Right(sNullen & LTrim$(Str$(Counter)), Len(Letters) + 1) & "_"
        '-----------------------------------------------------------------------------------------------
        aDoc.Sections.First.Range.Cut
        Set aDocNew = Documents.Add
        Selection.Paste
        '-----------------------------------------------------------------------------------------------
        'Naam samenstellen uit 8e alinea van tekst
        '-----------------------------------------------------------------------------------------------
        With aDocNew
[B]            tmp = Split(aDocNew.Content, Chr(13))
            DocName = DocName & tmp(7)
            If Right(DocName, 1) = Chr(13) Or Right(DocName, 1) = Chr(10) Then
                DocName = Left(DocName, Len(DocName) - 1)
            End If[/B]
            '-------------------------------------------------------------------------------------------
            .Sections(2).PageSetup.SectionStart = wdSectionContinuous
            .SaveAs _
                FileName:=Pad & DocName & ".doc", _
                FileFormat:=wdFormatDocument, _
                AddToRecentFiles:=False
        End With
        ActiveWindow.Close
        Counter = Counter + 1
    Wend

End Sub