PDA

View Full Version : [SOLVED] Saving Files As Read-Only



BravesPiano5
12-17-2013, 06:07 PM
Folks...I always come in for help but rarely offer any help or things that took me FOREVER to find. As a background for the below, I save and use a lot of files which are marked as read-only and it's a hassle to me to maneuver around it so I've decided to "rewrite" the save functions with read-only capability.

Basically:

SaveAs subfunction

Works just like normal SaveAs
Marks the saved workbook as read only
Marks the current workbook as read only (primarily as an identifier)


Save subfunction

Checks if the original file was marked as read-only and ensures the user wants to continue

Primarily a fool proof for myself! :doh:


Removes the read-only properties from the original file & active workbook
Saves the active workbook to the original file path
Marks the file path just saved as read only and remarks the current WB as read only




If anyone finds any issues or problems with the code...by all means let me know. :thumb


Sub SaveAsReadOnly()

Dim RequestName, CurrentFileLocation As String
Dim CurrentWBName As String

CurrentWBName = ActiveWorkbook.FullName
'Set the current active workbook name to utilize in the SaveAs prompt

'NOTE => Using FullName pulls the entire file path...when prompting where to save, Excel goes to this file path

On Error Resume Next
RequestName = Application.GetSaveAsFilename(CurrentWBName, "Excel Macro Enabled Workbook (*.xlsm), *.xlsm")
If RequestName = "False" Then Exit Sub
On Error GoTo 0
'Request the user to identify the file name and the location to save it

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:=RequestName, FileFormat:=52
VBA.SetAttr RequestName, vbReadOnly
Application.DisplayAlerts = True
'Save as Macro-enabled (52) and set as read only

With ActiveWorkbook
If Not .ReadOnly Then .ChangeFileAccess xlReadOnly
.Saved = True
End With
'Mark the current file as read-only and identify it as saved

End Sub



Sub SaveReadOnly()

Dim ShouldI As VbMsgBoxResult
Dim CurrentWBName As String
Dim CurrentWB As Workbook

CurrentWBName = ActiveWorkbook.FullName

If GetAttr(CurrentWBName) = vbReadOnly Then
ShouldI = MsgBox("The original file is currently marked as read only!" & vbNewLine & vbNewLine & Space(13) & _
"...Do you wish to continue?", vbYesNo + vbExclamation, "Read Only: Saving File")
If ShouldI = vbNo Then Exit Sub
End If
'Advise user the file is marked as read only and ensure if the macro should continue

Application.DisplayAlerts = True

On Error Resume Next
With ActiveWorkbook
VBA.SetAttr .FullName, vbNormal
'Go to file path and mark the file as normal (not read-only)

If .ReadOnly = True Then .ChangeFileAccess xlReadWrite
'Determine if the active workbook is read only and change the access rights

.SaveAs FileName:=CurrentWBName
'Resave the new
End With
On Error GoTo 0

VBA.SetAttr CurrentWBName, vbReadOnly
'Open back the original file path and mark it as read only

With ActiveWorkbook
If .ReadOnly = False Then .ChangeFileAccess xlReadOnly
.Saved = True
End With
'Mark the current file as read-only and identify it as saved

Application.DisplayAlerts = True

End Sub