I use the following to make sure guys here aren't changing stuff they shouldn't. when they close the new document it adds their name and date/time to the footer. It then performs a comparison to the original template and saves it to a specified folder. Also, each time the new document is opened and closed it does the comparison again and captures who is doing it in the footer.
Code:
Private Sub Document_New()
Dim oDoc As Document
Application.FileDialog(msoFileDialogSaveAs).InitialFileName = "Pick a name for the save function" ' Mine is the same as the template
Dim choice As Integer
choice = Application.FileDialog(msoFileDialogSaveAs).Show
If choice <> 0 Then
FileName = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
Application.FileDialog(msoFileDialogSaveAs).Execute
Set oDoc = ActiveDocument
End If
End Sub
Private Sub Document_Close()
Dim strPath As String
Dim lFmt As Long
Dim strOriginal As String
strPath = "Your chosen save folder" ' I created a folder on the company drive only I know where it is
Application.ScreenUpdating = False
ActiveDocument.Compare Name:= "C:\Users\yourname\Desktop\Personal\VBA test\Form XX-XX for project .docx", _ 'Your Template document name and location
CompareTarget:=wdCompareTargetNew
Set compareTargetNew = ActiveDocument
With ActiveDocument
strOriginal = .FullName
End With
With ActiveDocument.Sections(1)
.Footers(wdHeaderFooterPrimary).Range.Select
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"USERNAME ", PreserveFormatting:=True
Selection.TypeText Text:=vbTab
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"DATE \@ ""dddd, MMMM d, yyyy"" ", PreserveFormatting:=True
Selection.TypeText Text:=vbTab
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"TIME \@ ""h:mm:ss am/pm"" ", PreserveFormatting:=True
With ActiveDocument
.SaveAs2 FileName:=strPath & "/" & .Name, _
FileFormat:=lFmt, _
AddToRecentFiles:=False
.SaveAs2 FileName:=strOriginal, _
FileFormat:=lFmt, _
AddToRecentFiles:=False
End With
Application.ScreenUpdating = False
ActiveDocument.Close
End With
End Sub