Macro for Always saveas option

[maheshrk81]

Hi All,

I save a file is some path, where the file is saved as Read-only recommended. But few of then are opening as write and overwriting the file.
Can i have a macro, when the user saves the file, it should pop-up the msg saying they are not allowed to save the file in that path and show the SAVEAS option. Please help.

Thanks,
Mahi

 

[ParamRay]

Can try something like this, which goes in ThisWorkbook module:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Dim strInitialFilename As String
  Dim strExtensionName As String
  Dim strFileFilter As String
  Dim vntSaveAsFilename
  On Error GoTo ErrorHandler
  If Me.Path <> vbNullString Then
    Cancel = True
    Application.EnableEvents = False
    strInitialFilename = Replace(Me.FullName, Me.Name, "Copy of " & Me.Name)
    strExtensionName = CreateObject("Scripting.FileSystemObject").GetExtensionName(Me.Name)
    strFileFilter = "Excel Files (*." & strExtensionName & "), *." & strExtensionName
    vntSaveAsFilename = Application.GetSaveAsFilename(strInitialFilename, strFileFilter)
    If vntSaveAsFilename = False Then GoTo ExitHandler
    Me.SaveAs vntSaveAsFilename
  End If
ExitHandler:
  On Error Resume Next
  Application.EnableEvents = True
  Exit Sub
ErrorHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitHandler
End Sub

 

[maheshrk81]

Hi ParamRay,

Thanks you, this code worked perfect. But can we set-up only once particular Path? Like, i have a SharePoint site path where i save the file and i don't anyone to overwrite the file there. The users can download to local drive and do the changes. Is that possible through macro?

Thanks,
Mahesh

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Dim strInitialFilename As String
  Dim strExtensionName As String
  Dim strFileFilter As String
  Dim vntSaveAsFilename
  On Error GoTo ErrorHandler
  If Me.Path <> vbNullString Then
    Cancel = True
    Application.EnableEvents = False
    strInitialFilename = Replace(Me.FullName, Me.Name, "Copy of " & Me.Name)
    strExtensionName = CreateObject("Scripting.FileSystemObject").GetExtensionName(Me.Name)
    strFileFilter = "Excel Files (*." & strExtensionName & "), *." & strExtensionName
    vntSaveAsFilename = Application.GetSaveAsFilename(strInitialFilename, strFileFilter)
    If vntSaveAsFilename = False Then GoTo ExitHandler
    Me.SaveAs vntSaveAsFilename
  End If
ExitHandler:
  On Error Resume Next
  Application.EnableEvents = True
  Exit Sub
ErrorHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitHandler
End Sub

[/QUOTE]

 

[maheshrk81]

Hi,

Can we make a default Save as option to Desktop. Currently it is showing the same exiting path.

Thanks,
Mahi