Macro to prompt Save as Dialog when a workbook is opened

jmayna

New Member
Joined
Nov 30, 2010
Messages
5
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
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

VoG

Legend
Joined
Jun 19, 2002
Messages
63,650
Try this in the ThisWorkbook module (in the VBE Project window double click ThisWorkbook and paste in)

Code:
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

New Member
Joined
Nov 30, 2010
Messages
5
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

Legend
Joined
Jun 19, 2002
Messages
63,650
Try this:

Code:
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

New Member
Joined
Nov 30, 2010
Messages
5

ADVERTISEMENT

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

Legend
Joined
Jun 19, 2002
Messages
63,650
For example to default to Z:\Documents

Rich (BB code):
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
 

Forum statistics

Threads
1,137,063
Messages
5,679,399
Members
419,825
Latest member
MegastarMagus

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top