Macro for splitting a mail-merge document into single files.

reverse_mailmerge.asp

Sub Splitter()
    Dim Mask As String
    Dim Letters As Long
    Dim Counter As Long
    Dim DocName As String
    Dim oDoc As Document
    Dim oNewDoc As Document

    Set oDoc = ActiveDocument
    oDoc.Save

    Selection.EndKey Unit:=wdStory
    Letters = Selection.Information(wdActiveEndSectionNumber)
    Mask = "ddMMyy"
    Selection.HomeKey Unit:=wdStory

    Counter = 1
    While Counter < Letters
        DocName = "C:\\single_" & Format(Date, Mask) _
        & " " & LTrim$(Str$(Counter)) & ".docx"
        oDoc.Sections.First.Range.Cut
        Set oNewDoc = Documents.Add
        'Documents are based on the Normal template
        'To use an alternative template follow the link.
        With Selection
            .Paste
            .EndKey Unit:=wdStory
            .MoveLeft Unit:=wdCharacter, Count:=1
            .Delete Unit:=wdCharacter, Count:=1
        End With
        oNewDoc.SaveAs fileName:=DocName, _
        FileFormat:=wdFormatDocument, _
        AddToRecentFiles:=False
        ActiveWindow.Close
        Counter = Counter + 1
    Wend
    oDoc.Close wdDoNotSaveChanges
End Sub