CODEWITHSUNDEEP
excelvba
user2453446
user2453446

Reputation: 303

forbid saving as in a given folder using excel VBA

I have created a folder containing many .xls and .xlsm sheets, this folder will be distributed to many people in the company, in order not to alter the integrity of the sheets in the folder I want to disable saving any files in this folder, all filles saved will have to be "saved as" in a location different than the folder called project.Here is what have found so far.

Cheers

  Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     '  Following line will prevent all saving
    Cancel = True
     '  Following line displays the Save As Dialog box
    If SaveAsUI Then SaveAsUI = True
     ' How do I forbid the folders path ???
  End Sub

Upvotes: 5

Views: 1871

Answers (2)

brettdj
brettdj

Reputation: 55672

This version saves to the User Desktop regardless of the Windows O/S version

It also disables Events so that the code doesn't call itself recursively.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Object
Set ws = CreateObject("WScript.Shell")

If ThisWorkbook.Saved Then
    Application.EnableEvents = False
    ThisWorkbook.SaveAs ws.specialfolders("Desktop") & "\" & ThisWorkbook.Name
    MsgBox ThisWorkbook.Name & " saved to " & ws.specialfolders("Desktop")
    Application.EnableEvents = True
Else
    MsgBox "workbook has not been saved before", vbCritical
    Cancel = True
End If

End Sub

Upvotes: 0

user2140173
user2140173

Reputation:

I've come up with one way of doing it. Maybe someone can give you a better answer.

It will save a file to your default location which is set to be C:\MyFiles and show a MessageBox after with the path to the file.

Only use this code if you do not want to ask the user where to save the file and save it in a static location then notify him/her of the location the file was saved to.

The below code goes in here (ThisWorkbook Object Module)

enter image description here

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

    If SaveAsUI Then
        Cancel = True
    Else

        Dim path As String
        path = "C:\MyFiles\"

        If Len(dir(path, vbDirectory)) = 0 Then
           MkDir path
        End If

        Me.SaveAs Filename:=path & Me.Name, _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

        MsgBox "This file has been saved in " & path & Me.Name
        Cancel = True
        Exit Sub
    End If
End Sub

update!

If all your users are on Windows 7 than you can change the path to 

path = "C:\Users\" & Environ$("username") & "\Desktop\"

This will go to each user's desktop regardless of their username. The Environ$("username") function returns currently logged in username.

Upvotes: 3

Related Questions