Controlled Automated Save/SaveAs - Consistency Issues.

[noveske]

I want this to prevent the user from saving or saving as. Also don't want them to get the Save/Save As/Cancel dialogue on close. Either just go to performSaveAs or just clos
If they Save or Save As, the script will automatically run performSaveAs procedure.

performSaveAs procedure functions well.


When I attempt to Save as owner, performSaveAs works. Switch to user, sometimes it just saved as it's the owner, does nothing (first press) or runs performSaveAs.
Switch back to the owner, it runs performSaveAs. Could this be because I'm not testing it on different accounts?
I'm just ' disabling it between attempts, even tried making small changes to script and workbook to see if it triggers different.

When I open VBA and hit Reset. It will Save on first try as it should. But when switching between the 2 it's not consistent.
Is there a way to add a reset to the end of the script?

Tried searching and everything leads to resetting the contents of cells.
Even tried searching to force a pause break then reset. But search comes up with wait, then clear contents.

I even tried a double checking procedure. But couldn't get through that one.

Dim originalFilePath As String
Dim performSaveAs As Boolean

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Application.EnableEvents = False
    If SaveAsUI Or performSaveAs Then
      
        Cancel = True
        Dim newWorkbook As Workbook
        Set newWorkbook = Workbooks.Add
        
        ThisWorkbook.Sheets("DC").Unprotect Password:="peen"
        
        ThisWorkbook.Sheets("DC").Copy Before:=newWorkbook.Sheets(1)
        newWorkbook.Sheets("DC").Cells.Copy
        newWorkbook.Sheets("DC").Cells.PasteSpecial xlPasteValues
        
        ThisWorkbook.Sheets("DC").Protect Password:="peen"
        newWorkbook.Sheets("DC").Protect Password:="peen"
        
        Application.CutCopyMode = False
        
        Dim saveDate As String
        saveDate = Format(Date, "mmddyy")
        Dim cellValueB6 As String
        Dim cellValueB7 As String
        Dim cellValueB2 As String
        cellValueB6 = ThisWorkbook.Sheets("Input").Range("B6").value
        cellValueB7 = ThisWorkbook.Sheets("Input").Range("B7").value
        cellValueB2 = ThisWorkbook.Sheets("Input").Range("B2").value
        
        Dim folderPath As String
        folderPath = ThisWorkbook.Path & "\Completed DC-141"
        If Dir(folderPath, vbDirectory) = "" Then
            MkDir folderPath
        End If
        
        Dim newFilePath As String
        newFilePath = folderPath & "\" & saveDate & " - " & cellValueB7 & " " & cellValueB6 & " - " & cellValueB2 & ".xlsx"
        
        Application.DisplayAlerts = False
        newWorkbook.SaveAs Filename:=newFilePath
        Application.DisplayAlerts = True
        
        newWorkbook.Close SaveChanges:=False
    Else
        
        If IsOwner() Then
        ThisWorkbook.Saved = True 
        ThisWorkbook.Save 
    Else
       
        Cancel = True
        performSaveAs = True
    End If
    End If
Application.EnableEvents = True
End Sub

Function IsOwner() As Boolean

    Dim ownerUsernames As String
    ownerUsernames = "noveske"
    
    Dim currentUser As String
    currentUser = Environ("USERNAME")
    
    If InStr(1, ownerUsernames, currentUser, vbTextCompare) > 0 Then
        IsOwner = True
    Else
        IsOwner = False
    End If
End Function