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.
 

Some videos you may like

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

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
 

Watch MrExcel Video

Forum statistics

Threads
1,118,451
Messages
5,572,201
Members
412,447
Latest member
immy
Top