excel vba saveasui file path - excel

Question

I have created a template for registration of changes. These are the requests and further administration in the process. I have a code in this template to save the file as an excel macro enabled workbook, always. The problem with this code is that i can't define a specific folder to save the documents. In all cases the save as dialog box will pop up and the user must be able to define their own file name. I want to define the path for all the users. Does anyone know how to add a file location (path) in this macro in order to make it work?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FileNameVal As String
If SaveAsUI Then
FileNameVal = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
Cancel = True
If FileNameVal = "False" Then 'User pressed cancel
Exit Sub
End If
Application.EnableEvents = False
If Right(ThisWorkbook.Name, 5) <> ".xlsm" Then
ThisWorkbook.SaveAs Filename:=FileNameVal, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Else
ThisWorkbook.SaveAs Filename:=FileNameVal, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If
Application.EnableEvents = True
End If
End Sub
Thanks in advance.
Kind regards,
Remco H.

Answer 1

If you wish to generate a unique filename, you could use something like the following function:
Function NextFileName(basename As String) As String
Dim followup As Integer
Dim pathname As String
pathname = "C:\Temp\Temp\" ' Include the trailing path separator so that we don't have to do it later
followup = 1
Do
NextFileName = pathname & basename & "-" & followup & ".xlsm"
If Dir(NextFileName) = "" Then Exit Function
followup = followup + 1
Loop
End Function
You could then call it from your main code as
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FileNameVal As String
If SaveAsUI Then ' <-- Exclude the IF statement if you want EVERY save to have a new follow up number
' rather than just "Save As" saves
Application.EnableEvents = False
'Generate the filename
FileNameVal = NextFileName(Format(Now, "yymmdd"))
ThisWorkbook.SaveAs Filename:=FileNameVal, FileFormat:=xlOpenXMLWorkbookMacroEnabled
'Maybe advise the user that the save has happened, and where it went to
MsgBox "Spreadsheet saved as " & FileNameVal
Cancel = True
Application.EnableEvents = True
End If
End Sub