(Word365] Intercept all save attempts

[the7seal]

I am creating an automated template in VBA for Word365 and it is kicking my butt because of one problem I can't seem to solve. I am creating a document to function as a simple backup for when our dispatching software goes down. The documents will create a record of every incident we handle until the system is restored. All of the documents will be saved in a single folder on the network visible from the call centers in two different parts of the country. The filename of every saved document will be in the same format. This makes it easy for everyone (in both call centers) to see what incidents have been reported.

I have automated the process of saving each completed document using the same format to the same network folder, but only if the user uses Ctrl + S or F12. It works perfectly. The user hits Ctrl + S and a message pops up letting them know the file is being saved, lets them know the filename, and then lets them know when the save has been successful. However, if anyone saves using File -> Save As, it takes the user to the standard Save window and lets them type their own filename, thus defeating the entire purpose. Here's the code I have so far (I removed the server path):

ThisDocument module

'Intercepts "Save As" and F12
Sub FileSaveAs()
    ForceRestrictedSave
End Sub

'Intercepts "Save" and Ctrl+S
Sub FileSave()
    
    'If the document hasn't been saved yet, force the restricted path
    If ActiveDocument.Path = "" Then
        ForceRestrictedSave
    Else
        
        'If it has already been saved, just save the changes normally
        ActiveDocument.Save
    End If
End Sub

'The actual "Locked Folder" logic
Private Sub ForceRestrictedSave()
    Dim targetFolder As String, autoName As String, fullPath As String
    
    'Targets the save folder using the UNC Network Path (must end with a backslash \}
    targetFolder = \\server\path\
    'Pulls the generated name from the GetAutoFileName Function
    autoName = GetAutoFileName() & ".docx"
    fullPath = targetFolder & autoName
    
    'This checks if filename already exists
    If Dir(fullPath) <> "" Then
        If MsgBox("File '" & autoName & "' already exists. Overwrite?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
    End If
    
    'If the filename already exists, this creates a SaveAs2 filename
    On Error Resume Next
    ActiveDocument.SaveAs2 fileName:=fullPath

    'If there is an error, this shows the message box text
    If Err.Number <> 0 Then
        MsgBox "Save Failed! Check network connection or permissions.", vbCritical
    Else
        MsgBox "Saved as: " & autoName, vbInformation
    End If
    On Error GoTo 0
End Sub

And this code in the Module1 (renamed to Utilities)

Public Function GetAutoFileName() As String
    Dim doc As Document: Set doc = ActiveDocument
    Dim loc As String, prio As String
    Dim incLoc As String
    
    'Checks which Location box is checked using Title
    If doc.SelectContentControlsByTitle("LocationE")(1).Checked Then
        loc = "DUL"
    ElseIf doc.SelectContentControlsByTitle("LocationW")(1).Checked Then
        loc = "FTW"
    Else
        loc = "NoLoc"
    End If

    'Limits the incidentloc to 40 characters (since filename + filepath character limit is 260)
    'Also removes any characters that Windows hates in filenames
    incLoc = GetCCTextByTag("incidentloc")
    incLoc = Left(incLoc, 40)
    
    'Removes bad characters
    incLoc = CleanFileName(incLoc)

    'Formats the Priority with a leading "P"
    prio = "P" & GetCCTextByTag("Priority")

    'Strings it all together (Date-Time-Initials-Loc-Zip-Div-Event-Prio-IncLoc)
    'Replaces the slashed and colons from Date and Time to prevent Windows errors
    GetAutoFileName = Replace(GetCCTextByTag("Date"), "/", "") & "-" & _
                      Replace(GetCCTextByTag("Time"), ":", "") & "-" & _
                      GetCCTextByTag("Initials") & "-" & _
                      loc & "-" & _
                      GetCCTextByTag("zip") & "-" & _
                      GetCCTextByTag("division") & "-" & _
                      GetCCTextByTag("Event") & "-" & _
                      prio & "-" & _
                      GetCCTextByTag("incidentloc")
End Function
'Cleans up the filename by removing characters that can cause issues saving
Private Function CleanFileName(ByVal text As String) As String
    Dim i As Integer
    Dim badChars As Variant
    badChars = Array("/", "\", ":", "*", "?", """", "<", ">", "|", ",")
        
    'Replaces the bad character with an underscore "_"
    CleanFileName = text
    For i = 0 To UBound(badChars)
        CleanFileName = Replace(CleanFileName, badChars(i), "")
    Next i
End Function
'Gets text from a tag
Private Function GetCCTextByTag(tagName As String) As String
    Dim ccList As ContentControls
    Set ccList = ActiveDocument.SelectContentControlsByTag(tagName)
    If ccList.Count > 0 Then
        GetCCTextByTag = Trim(ccList(1).Range.text)
    Else
        GetCCTextByTag = "Missing"
    End If
End Function
Public Sub AppendAuditTrail(tagName As String, newValue As String)
    Dim currentLog As String
    Dim newEntry As String
    Dim timestamp As String
    
    'Create the entry: [Date Time] User - Field: Value
    timestamp = Format(Now, "yyyy-mm-dd HH:mm") & " EST"
    newEntry = "[" & timestamp & "] " & Application.userName & _
               " | " & tagName & " -> " & newValue
    
    'Retrieve the existing log from Document Variables
    On Error Resume Next
    currentLog = ActiveDocument.Variables("AuditLog").Value
    On Error GoTo 0
    
    'Append the new entry (separated by a pipe or newline)
    If currentLog = "" Then
        currentLog = newEntry
    Else
        currentLog = currentLog & vbCrLf & newEntry
    End If
    
    'Save it back to the hidden variable
    ActiveDocument.Variables("AuditLog").Value = currentLog
End Sub

I need some ideas as to how I can intercept a File -> Save As or File -> Save call from the ribbon. I've tried using a Class Module and Event, but even those attempts failed. Help!

[jdc2000]

Possibly useful link:

https://stackoverflow.com/questions/...e-as-using-vba

From AI:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If (SaveAsUI = True) Then
        MsgBox "Save As is disabled.", vbCritical, "Action Cancelled"
        Cancel = True
    End If
End Sub