Thread: [Solved] Protecting only 1 section
View Single Post
 
Old 05-28-2019, 09:17 AM
kilroy kilroy is offline Windows 10 Office 2016
Competent Performer
 
Join Date: Sep 2016
Location: Southern Ontario
Posts: 118
kilroy is on a distinguished road
Default

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

Last edited by kilroy; 05-28-2019 at 10:58 AM. Reason: spelling
Reply With Quote