Sub JederDatensatzInEineEigenstandigeDatei() 
 
 With ActiveDocument.MailMerge 
    If .MainDocumentType = wdNotAMergeDocument Then 
        MsgBox "Das aktive Dokument ist kein Seriendruckhauptdokument." 
        Exit Sub 
    End If 
    .DataSource.ActiveRecord = wdLastRecord 
    anzahl = .DataSource.ActiveRecord 
    If anzahl = 0 Then 
     MsgBox "Die Datenquelle ist leer." 
     Exit Sub 
    End If 
    flag = False 
    For Each x In .DataSource.DataFields 
     If x.Name = nName Then 
      flag = True 
      Exit For 
     End If 
    Next 
    If flag = False Then 
     q = Chr(34) 
     MsgBox "Das nominierte Feld" & q & nName & q & " existiert nicht in der" & _
       "Datenquelle." 
     Exit Sub 
    End If 
    .Destination = wdSendToNewDocument 
    For i = 1 To anzahl 
     .DataSource.ActiveRecord = i 
     dsname = "C:\" & _ 
      .DataSource.DataFields(nName).Value & ".doc" 
     .DataSource.FirstRecord = i 
     .DataSource.LastRecord = i 
     .Execute 
     ActiveDocument.Range.Find.Execute FindText:="^b", replacewith:="" 
     Set fs = CreateObject("Scripting.FileSystemObject") 
     If fs.fileexists(dsname) = True Then 
            MsgBox ("Eine Datei mit dem Namen " & dsname & " existiert" & _
              "bereits!") 
            ActiveDocument.Close (wdDoNotSaveChanges) 
     Else 
            ActiveDocument.SaveAs FileName:=dsname, AddToRecentFiles:=False 
            ActiveDocument.PrintOut 
 
            ActiveDocument.Close (wdDoNotSaveChanges) 
     End If 
 
   Next i 
     .DataSource.FirstRecord = 1 
 End With 
 
ActiveDocument.MailMerge.DataSource.Application.Quit 
ActiveDocument.Close (wdDoNotSaveChanges) 
ActiveDocument.Application.Quit 
End Sub