VBA to Change Save Location

[patrykp]

I've looked everywhere for this and have not been able to find the specific code to help me.

I would like to have a macro, possibly using the BeforeSave subroutine that when a user chooses to "save as" the file, the default save location will be a different folder than the folder the file is actually located in. The file will already be opened as a read only, so also choosing to just "save" should change the location as well.

The location will be a main directory from which they can navigate to whatever folder they want to save the file and be able to save under a file name of their choosing.

The purpose is that the original is in a location I do not want users accidentally saving to. And I don't want to have a save button or anything that calls for a separate subroutine. It needs to run directly from the save dialog box. Is that possible?

Any help would be appreciated.

 

[John_w]

Yes, this is possible. Call Application.FileDialog(msoFileDialogSaveAs) or Application.GetSaveAsFilename in the ThisWorkbook.Workbook_BeforeSave event.

 

[patrykp]

I tried using the following code:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
Dim fname As Variant
Dim NewWb As ThisWorkbook
fname = Application.GetSaveAsFilename(InitialFileName:="L:\", filefilter:=" Excel Macro Enabled Workbook (*.xlsm), *.xlsm", _
    FilterIndex:=1, Title:="Save the Document")
MsgBox fname 'this is just to test what happens
Application.ScreenUpdating = False
ThisWorkbook.SaveAs Filename:=fname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.ScreenUpdating = True
End Sub

.

But for some reason the dialog box shows up twice and only saves if I use the second prompt, not the first one.

If I remove the following code:

ThisWorkbook.SaveAs Filename:=fname, FileFormat:=xlOpenXMLWorkbookMacroEnabled

Then the prompt only comes up once, but obviously does not save.

Seems as if the code is looking through twice as the MsgBox comes up after the second prompt as well.

 

[John_w]

Seems as if the code is looking through twice as the MsgBox comes up after the second prompt as well.

Yes, because the SaveAs is triggering the Workbook_BeforeSave event. To handle this, disable events before the SaveAs:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim fname As Variant
    fname = Application.GetSaveAsFilename(InitialFileName:="L:\", filefilter:="Excel Macro Enabled Workbook (*.xlsm), *.xlsm", _
        FilterIndex:=1, Title:="Save the Document")
    If fname <> False Then
        Application.EnableEvents = False
        ThisWorkbook.SaveAs Filename:=fname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Application.EnableEvents = True
    End If
    Cancel = True
End Sub

The code also checks for Cancel being clicked on the save dialogue, otherwise if you click Cancel the workbook is saved as "FALSE.xlsm".