"Save in" in Excel

    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    ActiveWorkbook.SaveAs Filename:= _
        "YOURDIRECTORY" & "YOURFILENAME" & ".xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

    Application.EnableEvents = True
    Application.DisplayAlerts = True

Select allOpen in new window

The xlsx extension can be modified as well

Thank you... perhaps I should have provided the exisiting code ...  can you incorporate your suggestion?


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Val(Application.Version) >= 12 Then
fname = Application.GetSaveAsFilename(filefilter:= _
"Excel Macro Enabled Workbook (*.xlsm), *.xlsm,Excel Macro Enabled Template (*.xltm), *.xltm,Excel 2003 Workbook (*.xls), *.xls,Excel 2003 Template (*.xlt), *.xlt", _
Title:="Save Workbook in Excel")
'Check if cancel was hit
If fname = False Then
Cancel = True
'ActiveWorkbook.SaveAs fname, FileFormatValue, CreateBackup:=False
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
Else
End If
'Find the correct FileFormat that match the choice in the "Save as type" list
If fname <> False Then
Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
Case "xlt": FileFormatValue = 17
Case "xls": FileFormatValue = 56
Case "xlsm": FileFormatValue = 52
Case "xltm": FileFormatValue = 53
Case Else: FileFormatValue = 0
End Select
End If
If FileFormatValue = 0 Then
MsgBox "Sorry, unknown file extension"
Cancel = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
End If
Application.DisplayAlerts = False
Application.EnableEvents = False
Cancel = True
ActiveWorkbook.SaveAs fname, FileFormatValue, CreateBackup:=False
Application.DisplayAlerts = True
Application.EnableEvents = True
End If
End Sub

Seems you already have the save as function implemented. Its just you are not saving it into a directory

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Val(Application.Version) >= 12 Then
fname = Application.GetSaveAsFilename(filefilter:= _
"Excel Macro Enabled Workbook (*.xlsm), *.xlsm,Excel Macro Enabled Template (*.xltm), *.xltm,Excel 2003 Workbook (*.xls), *.xls,Excel 2003 Template (*.xlt), *.xlt", _
Title:="Save Workbook in Excel")
'Check if cancel was hit
If fname = False Then
Cancel = True
'ActiveWorkbook.SaveAs fname, FileFormatValue, CreateBackup:=False
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
Else
End If
'Find the correct FileFormat that match the choice in the "Save as type" list
If fname <> False Then
Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
Case "xlt": FileFormatValue = 17
Case "xls": FileFormatValue = 56
Case "xlsm": FileFormatValue = 52
Case "xltm": FileFormatValue = 53
Case Else: FileFormatValue = 0
End Select
End If
If FileFormatValue = 0 Then
MsgBox "Sorry, unknown file extension"
Cancel = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
End If
Application.DisplayAlerts = False
Application.EnableEvents = False
Cancel = True
fname = "DIRECTORYHERE" & fname
ActiveWorkbook.SaveAs fname, FileFormatValue, CreateBackup:=False
Application.DisplayAlerts = True
Application.EnableEvents = True
End If
End Sub

Select allOpen in new window

On this line (about 5 lines from bottom)

fname = "DIRECTORYHERE" & fname

Change whatever inside the quote to your directory. Eg: C:\Dir\

So that your new line would look like

fname = "C:\Dir\" & fname

Shanan212:

I am not able to get your code to work.

The user needs to be able to choose and change the file name but the default directory should to a folder in their My Documents... and depending on their version of Windows it may be Documents or My Documents.

If Mid(Path1, 4, 4) = "User" Then
fname = "\Documents\Folder1\"
Else
fname = "\My Documents\Folder1\"
End If