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]

Please post the VBA code you have for that button.

Here you go

Sub SaveFile()

Dim fname As String
Dim path As String
Dim SaveAs As String



    
    If Len(Dir(Range("project_folder_link"), vbDirectory)) = 0 Then
    SaveAs = Range("save_as2")
    Range("used_product_name") = Range("pt_2")
    Range("save_As_output") = Range("save_As2")
    path = Range("file_Saved2")
    
    Else
    SaveAs = Range("save_as")
    Range("used_product_name") = Range("pt_1")
    Range("save_As_output") = Range("save_As")
    path = Range("file_Saved")
    End If
    
    
    Range("tester") = SaveAs
    If Len(Dir(SaveAs, vbDirectory)) = 0 Then
    MkDir SaveAs
    End If
    
    If Len(Dir(Range("file_1"), vbDirectory)) = 0 Then
    MkDir Range("file_1")
    End If
    
    If Len(Dir(Range("file_2"), vbDirectory)) = 0 Then
    MkDir Range("file_2")
    End If
    
    If Len(Dir(Range("file_3"), vbDirectory)) = 0 Then
    MkDir Range("file_3")
    End If
    
    If Len(Dir(Range("file_4"), vbDirectory)) = 0 Then
    MkDir Range("file_4")
    End If
    
    If Len(Dir(Range("file_5"), vbDirectory)) = 0 Then
    MkDir Range("file_5")
    End If
    
    If Len(Dir(Range("file_6"), vbDirectory)) = 0 Then
    MkDir Range("file_6")
    End If
    
    If Len(Dir(Range("file_7"), vbDirectory)) = 0 Then
    MkDir Range("file_7")
    End If
    
    If Len(Dir(Range("file_8"), vbDirectory)) = 0 Then
    MkDir Range("file_8")
    End If
    
    If Len(Dir(Range("file_9"), vbDirectory)) = 0 Then
    MkDir Range("file_9")
    End If
    
    If Len(Dir(Range("file_10"), vbDirectory)) = 0 Then
    MkDir Range("file_10")
    End If
    
    If Len(Dir(Range("file_10.1"), vbDirectory)) = 0 Then
    MkDir Range("file_10.1")
    End If
    
    If Len(Dir(Range("file_10.2"), vbDirectory)) = 0 Then
    MkDir Range("file_10.2")
    End If
    
    If Len(Dir(Range("file_11"), vbDirectory)) = 0 Then
    MkDir Range("file_11")
    End If
    
    If Len(Dir(Range("file_12"), vbDirectory)) = 0 Then
    MkDir Range("file_12")
    End If
    
    If Len(Dir(Range("file_13"), vbDirectory)) = 0 Then
    MkDir Range("file_13")
    End If
    
    If Len(Dir(Range("file_14"), vbDirectory)) = 0 Then
    MkDir Range("file_14")
    End If
    
    If Len(Dir(Range("file_15"), vbDirectory)) = 0 Then
    MkDir Range("file_15")
    End If
    
    If Len(Dir(Range("file_16"), vbDirectory)) = 0 Then
    MkDir Range("file_16")
    End If
    
    If Len(Dir(Range("file_17"), vbDirectory)) = 0 Then
    MkDir Range("file_17")
    End If
    
    If Len(Dir(Range("file_18"), vbDirectory)) = 0 Then
    MkDir Range("file_18")
    End If
    
Dim answer
Dim answer2
    
    If Len(Dir(path)) <> 0 Then
    answer = MsgBox("A 'Precast Bridge Design Template' has already been saved into this folder! Please check the folder before saving!", vbOKOnly, "Save ERROR")
    Exit Sub
    Else:
    Application.ActiveWorkbook.SaveAs Filename:=path, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    answer2 = MsgBox("A 'Precast Bridge Design Template' has been saved into the Structural Folder for this project!", vbOKOnly, "File SAVED")
    End If
    
    
Dim oWSH As Object
Dim oShortcut As Object
    
    Set oWSH = CreateObject("WScript.Shell")
    Set oShortcut = oWSH.CreateShortCut(Range("save_As_output") & "\" & _
    "CANDE Folder.lnk")
    With oShortcut
    .TargetPath = Range("file_11")
    .Save
    End With
    Set oWSH = Nothing
    
    Set oWSH = CreateObject("WScript.Shell")
    Set oShortcut = oWSH.CreateShortCut(Range("file_11") & "\" & _
    Range("fName") & ".lnk")
    With oShortcut
    .TargetPath = Range("save_As_output")
    .Save
    End With
    Set oWSH = Nothing
    
    
    End Sub

 

[Joe4]

OK, this looks like it is the only line doing the "Save":

   Application.ActiveWorkbook.SaveAs Filename:=path, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

So, if we temporarily disable events from firing while that line is running, it will not call/run that other code.
We can do that by surrounding that line of code above with the following:

   Application.EnableEvents = False
   Application.ActiveWorkbook.SaveAs Filename:=path, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
   Application.EnableEvents = True

 

[jrisebo]

OK, this looks like it is the only line doing the "Save":

   Application.ActiveWorkbook.SaveAs Filename:=path, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

So, if we temporarily disable events from firing while that line is running, it will not call/run that other code.
We can do that by surrounding that line of code above with the following:

   Application.EnableEvents = False
   Application.ActiveWorkbook.SaveAs Filename:=path, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
   Application.EnableEvents = True

I will give it a try. Thanks. Update when I get it done.

 

[jrisebo]

OK, this looks like it is the only line doing the "Save":

   Application.ActiveWorkbook.SaveAs Filename:=path, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

So, if we temporarily disable events from firing while that line is running, it will not call/run that other code.
We can do that by surrounding that line of code above with the following:

   Application.EnableEvents = False
   Application.ActiveWorkbook.SaveAs Filename:=path, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
   Application.EnableEvents = True

That worked for this, the button works fine.

Last issue is once the spreadsheet is saved outside my restricted folder path (myDir in the code), is there any way to go back to allowing the excel save button to function as normal, i.e. not open the save as box?

 

[Joe4]

Last issue is once the spreadsheet is saved outside my restricted folder path (myDir in the code), is there any way to go back to allowing the excel save button to function as normal, i.e. not open the save as box?

Then what would prevent the following scenario.
Let's say that they saved it outside of the restricted folder path.
If we then disabled the code, what would prevent them from saving it BACK to that file path?

I think you want to leave it in there, or else you kind of defeated the purpose of having code to prevent them from saving to that particular folder.

 

[jrisebo]

Then what would prevent the following scenario.
Let's say that they saved it outside of the restricted folder path.
If we then disabled the code, what would prevent them from saving it BACK to that file path?

I think you want to leave it in there, or else you kind of defeated the purpose of having code to prevent them from saving to that particular folder.

My main reason for doing this was the person would start with this template, fill out the info and then hit my Save As macro button. It then copies it out to the project folder, and I could care less what they do at that point with the file, since I know my template is still virgin. What the issue is, people would open it, change values, and then just hit the save button, overwriting my virgin spreadsheet inside the folder. So my point of this exercise is to ban them from saving into this folder. Yes, they still could do a save as back into the folder, but very unlikely, unless malicious.

Once its out of my folder, I want them to be able to modify, save, modify, save, etc to their hearts content.

Hope that makes sense.

 

[Joe4]

Note that without that code, they could write it back to the original folder, and overwrite your original "virgin" file.

Quite frankly, I think what you now want to do raises the complexity level a bit, and is not really something I have the time (or desire) to delve into (getting to the point where we are now was a bit complex and painful).

It appears that we have come up with a solution to your original question. If you would like to start a new thread on your new "twist", feel free to do so.

 

[jrisebo]

Note that without that code, they could write it back to the original folder, and overwrite your original "virgin" file.

Quite frankly, I think what you now want to do raises the complexity level a bit, and is not really something I have the time (or desire) to delve into (getting to the point where we are now was a bit complex and painful).

It appears that we have come up with a solution to your original question. If you would like to start a new thread on your new "twist", feel free to do so.

Ok, thanks. I will hold off on that, perhaps someone else will chime in on here with an idea.

 

[jrisebo]

Ok, one idea, how hard is it to add to my 'Save As' button some code to delete your code. i.e. if they hit the button as they are supposed to, it would delete your code and be back to normal life.

 

[Joe4]

Ok, one idea, how hard is it to add to my 'Save As' button some code to delete your code. i.e. if they hit the button as they are supposed to, it would delete your code and be back to normal life.

I have never created code that deletes other code. I know people have done it, but I have never ventured into that.

One option you could do is update some "flag" somewhere, i.e. update some unused cell with some value.
Then, you could add an IF statement to my code that exits if the value is equal to something, i.e. put at the top of that code:

If Sheets("Sheet1").Range("A1") = "some value" Then Exit Sub

So if that flag field was some value of your determining, the code would exit before it gets to the part that does all the work.