Private Sub cmdSpeichern_Click()
Dim varRetVal As Variant, strInitFileName As String, Datname As String
Dim Pfad As String
Dim Dateiname As String
Dateiname = Application.InputBox(prompt:="Bitte Informationsnamen eingeben:")
Dateiname = Dateiname & " -Klassifizierung " & Format(Now, "DD-MM-YYYY") & ".xlsm"
varRetVal = Application.GetSaveAsFilename( _
InitialFileName:=Pfad & Dateiname, _
FileFilter:="Microsoft Excel-Dateien (*.xlsm), *.xlsm", _
Title:="Formular speichern unter... ")
If varRetVal = False Then Exit Sub
ActiveWorkbook.SaveAs varRetVal
End Sub