Ensure workbook name is not changed

msgrant

New Member
Joined
Apr 28, 2004
Messages
23
How can I ensure that a workbook when saved is only saved under its current name therefore not enabling another user to save as a different workbook name. I have used macro to save in two separate locations for security purposes with a specific name and location but if name is changed by save as then backup copy is not saved to same location.
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Fausto

New Member
Joined
Jul 28, 2004
Messages
44
Hey there,

Please paste this into your project and see if it is what you're looking for. One issue is that it will only allow the user to save the file to the same location... It should be relatively easy to strip out the path of the file name in the saveas variable.

I hope this helps, if not please post again!!!

Regards

Fausto Di-Trapani


Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.EnableEvents = False
Cancel = True
Dim saveas As String
If SaveAsUI = True Then
saveas = Application.GetSaveAsFilename(filefilter:="Microsoft Excel Workbook (*.xls), *.xls")
If saveas = "False" Then
Application.EnableEvents = True
Exit Sub
End If
Else
saveas = "Normal"
End If
If saveas = "Normal" Then
Me.Save
Else
If saveas <> ThisWorkbook.Path & "\Sheet Name.xls" Then
MsgBox "Illegal filename!!!" & vbCrLf & "The filename must be Sheet Name.xls", vbCritical, "Error"
Application.EnableEvents = True
Exit Sub
Else
Me.saveas saveas
End If
End If
Me.Saved = True
Application.EnableEvents = True
End Sub
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hello, msgrant,
would this do ?
Code:
Private Sub Workbook_BeforeSave(ByVal CheckSaveAs As Boolean, Cancel As Boolean)
    If CheckSaveAs Then
    MsgBox "SaveAs not allowed", 48, "TITLE"
    Cancel = True
    End If
End Sub
kind regards,
Erik
 

Fausto

New Member
Joined
Jul 28, 2004
Messages
44
Msgrant,

After initially replying, I thought what if the user changes the file name in explorer, this should stop the buggers from doing this... I have edited the code slightly:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.EnableEvents = False
Cancel = True
Dim saveas As String
If SaveAsUI = True Then
saveas = Application.GetSaveAsFilename(filefilter:="Microsoft Excel Workbook (*.xls), *.xls")
If saveas = "False" Then
Application.EnableEvents = True
Exit Sub
End If
Else
saveas = "Normal"
End If
If saveas = "Normal" Then
If ThisWorkbook.Name <> "Sheet Name.xls" Then
MsgBox "Illegal filename!!!" & vbCrLf & "The filename must be Sheet Name.xls", vbCritical, "Error"
Application.EnableEvents = True
Exit Sub
End If
Else
If saveas <> ThisWorkbook.Path & "\Sheet Name.xls" Then
MsgBox "Illegal filename!!!" & vbCrLf & "The filename must be Sheet Name.xls", vbCritical, "Error"
Application.EnableEvents = True
Exit Sub
Else
Me.saveas saveas
End If
End If
Me.Saved = True
Application.EnableEvents = True
End Sub


Hope this helps
 

Fausto

New Member
Joined
Jul 28, 2004
Messages
44
Msgrant

Im really sorry, but I made a little error in my last post... I have edited the code and I have re attached it below. Please excuse the previous error and disregard my previous posts. That little bit of code could have made you cry, it sometimes would (in certain circumstances) not save changes to a file... Once again my appologies!!!

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.EnableEvents = False
Cancel = True
Dim saveas As String
If SaveAsUI = True Then
    saveas = Application.GetSaveAsFilename(filefilter:="Microsoft Excel Workbook (*.xls), *.xls")
    If saveas = "False" Then
        Application.EnableEvents = True
        Exit Sub
    End If
Else
    saveas = "Normal"
End If
If saveas = "Normal" Then
    If ThisWorkbook.Name <> "Sheet Name.xls" Then
        MsgBox "Illegal filename!!!" & vbCrLf & "The filename must be Sheet Name.xls", vbCritical, "Error"
        Application.EnableEvents = True
        Exit Sub
    Else
        Me.Save
    End If
Else
    If saveas <> ThisWorkbook.Path & "\Sheet Name.xls" Then
        MsgBox "Illegal filename!!!" & vbCrLf & "The filename must be Sheet Name.xls", vbCritical, "Error"
        Application.EnableEvents = True
        Exit Sub
    Else
         Me.saveas saveas
    End If
End If
Me.Saved = True
Cancel = False
Application.EnableEvents = True
End Sub
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,999
Messages
5,834,809
Members
430,323
Latest member
Regash

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