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!

    • 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. 

 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