Save As Restrictions

[jrisebo]

We keep our files in a shared network folder. Users can open the spreadsheet, and then should save as to a separate location. Our IT department wont restrict the folder to read only, so anyone can overwrite the files inside it. I want to eliminate one way to do that by having code in the file not allowing the spreadsheet be saved in the folder. Anyway to do that?

 

[jrisebo]

Sorry, I thought when you mentioned that the project already had VBA code, that you might be able to write the code.
Here is some code. You would just need to change the value of "myDir".

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim fname As String
    Dim myDir As String
   
'   Specify the folder path they CANNOT save to
    myDir = "C:\Temp\"
   
'   Get file save name
    fname = Application.GetSaveAsFilename
   
'   Check to see if they are trying to save to restricted directory
    If UCase(Left(fname, Len(myDir))) = UCase(myDir) Then
        Cancel = True
        MsgBox "You cannot save file to " & myDir & " directory.", vbOKOnly, "ERROR!"
    Else
        MsgBox "File Saved"
    End If
   
End Sub

Not sure what I am doing wrong, I add this to a existing file, change the path, but then it still lets me save, save as into that directory.

I tried just a new file, and hit save, it brought up a 'save as' dialog box, I pick a new location, and hit save. A message box pops up and says 'file saved' I look in the folder I picked, and no file. I look at the original file, and its saved, as the date updates. So I am not sure what I am doing wrong.

The myDir path is a network folder, do I need anything different for that?

I put the code in the 'thisWorkbook' location under the VBA code.

Thanks

 

[Joe4]

Try adding this meesage box to your code, and see what it returns when you try saving the file:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim fname As String
    Dim myDir As String
    
'   Specify the folder path they CANNOT save to
    myDir = "C:\Temp\"
    
'   Get file save name
    fname = Application.GetSaveAsFilename
    
'   Check to see if they are trying to save to restricted directory
    MsgBox myDir & vbCrLf & Left(fname, Len(myDir))
    If UCase(Left(fname, Len(myDir))) = UCase(myDir) Then
        Cancel = True
        MsgBox "You cannot save file to " & myDir & " directory.", vbOKOnly, "ERROR!"
    Else
        MsgBox "File Saved"
    End If
    
End Sub

 

[jrisebo]

Try adding this meesage box to your code, and see what it returns when you try saving the file:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim fname As String
    Dim myDir As String
   
'   Specify the folder path they CANNOT save to
    myDir = "C:\Temp\"
   
'   Get file save name
    fname = Application.GetSaveAsFilename
   
'   Check to see if they are trying to save to restricted directory
    MsgBox myDir & vbCrLf & Left(fname, Len(myDir))
    If UCase(Left(fname, Len(myDir))) = UCase(myDir) Then
        Cancel = True
        MsgBox "You cannot save file to " & myDir & " directory.", vbOKOnly, "ERROR!"
    Else
        MsgBox "File Saved"
    End If
   
End Sub

Ok, will do. Should I just do a new module and copy this into the file? There is other VBA code, so how does it know to run this one?

 

[Joe4]

Event Procedure code (which is VBA code that is automatically invoked by some event/action happening) MUST follow certain rules:

1. It cannot be in a General module. It MUST be placed in the appropriate "ThisWorkbook" or "Sheet" module.
All "Workbook_BeforeSave" event procedure code MUST be placed in the "ThisWorkbook" module.

2. It MUST be named a certain way. You CANNOT edit/change anything in this procedure name row, i.e. this one MUST start out with:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

If you change the name of it, it will NOT run automatically.

You just want to add the line in red from my previous post to your current procedure.
When you try to save the file, it should run automatically, and return a Message Box to your screen.
Show me exactly what that Message Box is returning.

 

[jrisebo]

So I added the line of code. I hit save. It opens a 'Save As' Dialog box.

I pick another folder, but it wont save, its not the normal excel save as dialog box. So I hit cancel, its pops this up:

I hit ok, pops this up:

hit ok again, and it saves over the original file in the 'myDir' location.

 

[Joe4]

Can you post your version of the code, exactly as you have it?
And explain to me the exacty process that you try to save the file (how you are initiating the save)?

Alos, please update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

 

[jrisebo]

Can you post your version of the code, exactly as you have it?
And explain to me the exacty process that you try to save the file (how you are initiating the save)?

Alos, please update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

I use the save button at the top of the spreadsheet. It opens that dialog box, but not a file save dialog box. I hit cancel, and ensuing boxes appear.

 

[Joe4]

Please post the VBA code you have behind that button, and VBA code you copied from me and edited.
By the way, I would recommend adding a backslash at the end of your file path, i.e.

    myDir = "C:\Excel Files\"

 

[jrisebo]

Its the save button that comes with excel.

I added the backslash, still no different.

 

[Joe4]

OK, I will ask one more time. Please post your version of my code that you are using, in its entirety.
The behavior doesn't seem quite right to me, so I want to make sure that you have everything in the correct place in the code.