Protecting the Header in Word with Macros

Recently I was asked how to protect a specific area of a document's header in Microsoft Word. The aim is to stop editing the main content but to allow the header to be changed. As it turns out you cannot do this and so I had to think of some other solution. What I came up with is quite simple but requires you to use a Macro and Word Forms for some simple data entry. I hope this is useful for someone as it took me a little while to figure it out.

Internals of Word Document Protection

Protection of OpenXML Word (.docx and .docm) files is simple and in our use case not encrypted, it is only intended to stop accidental modification and can be subverted very easily. The protection is provided in word/settings.xml and is in a tag like this:

<w:documentProtection w:edit="readOnly" w:enforcement="1" 
    w:cryptProviderType="rsaFull" w:cryptAlgorithmClass="hash" 
    w:cryptAlgorithmType="typeAny" w:cryptAlgorithmSid="4" 
    w:cryptSpinCount="100000" w:hash="j19mZEAdG0EtAqvKOjVRMXhLCZ4=" 
    w:salt="rEnxYxPzmf8p53logJvujg=="/>

I took this from a document on my machine, the password is "MyPassword".

I use WordDocX to alter a file that the user can edit a little bit, mainly just to change styles. As the document is not encrypted and WordDocX does not care about editing the settings.xml file I can ignore all this and protect it through the word user interface.

Changing the header with VBA

This was the most frustrating part, I may be doing something silly but this is what I did.

First, unprotect the document with a hard-coded password:

ActiveDocument.Unprotect Password:="MyPassword"

You can detect if the document is protected using the ProtectionType property of ActiveDocument:

If ActiveDocument.ProtectionType <> wdNoProtection Then
    ' do some stuff
End If

Then alter the header... in a rather unconventional way, I know this is not good but it does the job:

TitleLine = 1
TitleLine1 = "My Title Line"
With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
    .Range.Paragraphs(TitleLine).Range.InsertParagraphBefore
    .Range.Paragraphs(TitleLine).Range.InsertBefore TitleLine1
End With

Word UserForms

Often the user must be able to enter some data, for this a Word UserForm is quite useful.

To show the form when the user opens the document (and allows Macros to run) enter this code into your document (double click "ThisDocument" in the left area).

Option Explicit

Private Sub Document_Open()
    TitleEntryForm.Show
End Sub

References

• Creating a UserForm (YouTube Video)
• How to set Editing Restrictions in Word OpenXML

Summary

That is about it, I used a form that allows the user to enter the details and then inserts up to three lines into the document. The code is here:

Option Explicit

Private Sub SetTitleButton_Click()
Dim Para As Paragraph
Dim TitleLine As Integer
Dim TitleLine1 As String
Dim TitleLine2 As String
Dim TitleLine3 As String
Dim DocumentPassword As String

DocumentPassword = "MyPassword"

On Error GoTo ErrorHandler:

If ActiveDocument.ProtectionType <> wdNoProtection Then
    ActiveDocument.Unprotect Password:=DocumentPassword
End If

Application.ScreenUpdating = False

With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
    TitleLine1 = Title1Text.Text
    TitleLine2 = Title2Text.Text
    TitleLine3 = Title3Text.Text
    TitleLine = 1
    .Range.Paragraphs(TitleLine).Range.InsertParagraphBefore
    .Range.Paragraphs(TitleLine).Range.InsertBefore TitleLine1
    If TitleLine2 <> "" Then
    TitleLine = TitleLine + 1
    .Range.Paragraphs(TitleLine).Range.InsertParagraphBefore
    .Range.Paragraphs(TitleLine).Range.InsertBefore TitleLine2
    End If
    If TitleLine3 <> "" Then
    TitleLine = TitleLine + 1
    .Range.Paragraphs(TitleLine).Range.InsertParagraphBefore
    .Range.Paragraphs(TitleLine).Range.InsertBefore TitleLine3
    End If
    .Range.Paragraphs(TitleLine + 1).Range.Delete
    If .Range.Paragraphs(TitleLine + 1).Style = ActiveDocument.Styles("HeadingAddress") Then
    .Range.Paragraphs(TitleLine + 1).Range.Delete
    End If
    If .Range.Paragraphs(TitleLine + 1).Style = ActiveDocument.Styles("HeadingAddress") Then
    .Range.Paragraphs(TitleLine + 1).Range.Delete
    End If
End With

ActiveDocument.Protect Type:=wdAllowOnlyReading, Password:=DocumentPassword

Application.ScreenUpdating = True

TitleEntryForm.Hide

Exit Sub

ErrorHandler:
MsgBox "Oops, Something went wrong. If you believe in God then he/she/it will help you, otherwise please find someone who knows what they are doing."
Application.ScreenUpdating = True
End Sub