Macro to prompt Save as Dialog when a workbook is opened

[jmayna]

Hi All,

I'm new to doing macros but I'm picking up on their usefullness as i go...

I've created a spreadsheet that will be kept on the company server in the templates folder, but to prevent people editing it I would like the "Save As" dialog box to open every time the sheet is opened, that way eliminating people accidentally saving changes to it?

I've had a few stabs at it, but no joy yet... Can anyone help?

Thanks,

Jon

 

[VoG]

Try this in the ThisWorkbook module (in the VBE Project window double click ThisWorkbook and paste in)

Private Sub Workbook_Open()
Dim fNameAndPath As Variant
fNameAndPath = Application.GetSaveAsFilename(initialFilename:="", FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Save As")
If fNameAndPath = False Then Exit Sub
Me.SaveAs Filename:=fNameAndPath
End Sub

 

[jmayna]

Wow, that's so cool! I was looking at one of your many solutions earlier to try and find out the answer, but this works like a dream =)

Is there any way of modifying the code to define the location where the Save As dialog box goes to? (Obviously I want it to point to a location on the company server)

Also, since this code is a lot different to any that I have done myself, how would i add in code so that a message displayed simultaneously telling people why the save as dialog had popped up?

You've been a massive help already, thanks so much!

Jon

 

[VoG]

Try this:

Private Sub Workbook_Open()
Dim fNameAndPath As Variant
MsgBox "Please save a copy of this workbook." & vbNewLine & "You will be prompted to save when you click OK.", vbInformation
fNameAndPath = Application.GetSaveAsFilename(initialFilename:=ThisWorkbook.Path & "\", FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Save As")
If fNameAndPath = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=fNameAndPath
End Sub

 

[jmayna]

Absolute legend! How would i modify that code to specify the location for the save as dialog? It works so beautifully i don't want to break it!

Thanks,

Jon

 

[VoG]

For example to default to Z:\Documents

Private Sub Workbook_Open()
Dim fNameAndPath As Variant
MsgBox "Please save a copy of this workbook." & vbNewLine & "You will be prompted to save when you click OK.", vbInformation
fNameAndPath = Application.GetSaveAsFilename(initialFilename:="Z:\Documents\", FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Save As")
If fNameAndPath = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=fNameAndPath
End Sub

 

[jmayna]

Works like a charm =)

Thanks for all your help, you're a credit to the site!

Jon