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

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,212,056
Messages
6,105,650
Members
447,974
Latest member
misspancake

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