Private Sub Document_New()
 
Dim dwOpenedDrafts As Long
 
' lesen und um eins erhöhen
dwOpenedDrafts = GetSetting(App.Title, "Settings", "DraftCount",0) + 1
 
ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = "Vorlage" & _
  "" & CStr(dwOpenedDrafts)
 
' den aktuellen Wert schreiben
Call SaveSetting(App.Title, "Settings", "DraftCount")
 
End Sub