Speichern unter - Vorgabe

Dim datum As String
Dim segment As String
Dim name As String
Dim varRetVal As Variant
Dim Datname As String
Dim sPfad As String
sPfad = VBA.Environ("USERPROFILE") & "\Documents\Unterlagen\Reports\Budget 2017"
If Dir(sPfad, vbDirectory) = "" Then
VBA.MkDir Path:=sPfad
End If
sPfad = sPfad & Application.PathSeparator
With ActiveWorkbook.Worksheets(1)
datum = Format(Date, "yyyy-mm-dd")
name = .Range("B1")
segment = .Range("C3")
End With
Datname = datum & "_" & segment & "_" & name
varRetVal = Application.GetSaveAsFilename( _
InitialFileName:=sPfad & Datname, _
FileFilter:="Microsoft Excel-Dateien (*.xlsx), *.xlsx", _
Title:="save as... ")
If varRetVal = False Then Exit Sub
ActiveWorkbook.SaveAs varRetVal, FileFormat:= _
xlOpenXMLWorkbook