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
 

Some videos you may like

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

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

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,105,963
Messages
5,508,417
Members
408,684
Latest member
Amos101

This Week's Hot Topics

Top