Dim WithEvents app As Application
Private Sub app_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
Dim Pfad As String, Dateiname As String
Pfad = "C:\Users\Name\Documents\"
If Doc Is ThisDocument Then
If Doc.Sentences.Count > 0 Then
Dateiname = Doc.Sentences(1)
If Right(Dateiname, 1) = Chr(13) Then Dateiname = Left(Dateiname, Len(Dateiname) - 1)
Application.DisplayAlerts = wdAlertsNone
Doc.SaveAs Pfad & Dateiname & ".docx"
Application.DisplayAlerts = wdAlertsAll
Cancel = True
End If
End If
End Sub
Private Sub Document_Open()
Set app = Application
End Sub