Trying to create or remove Watermarks depending on filename - vba

Question

I need an 'autorun' piece of VBA for Word 2013 to either add or remove a Watermark dependent on the filename of the document. I want to add this to a template we use for our Technical Reports which, in turn, are generated by an external Application/System and automatically named in the process. So the same document template may be named differently dependent on workflow
For documents entitled "DRAFT.XXX.NNNNNNNN.." I want a 'Draft' watermark
For any other documents there should be no watermark (or the watermark could be coloured white, ie invisible)
I've successfully created VBA/Macros to insert or remove Watermarks:
Sub InsertWaterMark()
Dim strWMName As String
On Error GoTo ErrHandler
'selects all the sheets
ActiveDocument.Sections(1).Range.Select
strWMName = ActiveDocument.Sections(1).Index
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
'Change the text for your watermark here
Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, _
"DRAFT", "Arial", 1, False, False, 0, 0).Select
With Selection.ShapeRange
.Name = strWMName
.TextEffect.NormalizedHeight = False
.Line.Visible = False
With .Fill
.Visible = True
.Solid
.ForeColor.RGB = Gray
.Transparency = 0.5
End With
.Rotation = 315
.LockAspectRatio = True
.Height = InchesToPoints(2.42)
.Width = InchesToPoints(6.04)
With .WrapFormat
.AllowOverlap = True
.Side = wdWrapNone
.Type = 3
End With
.RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
'If using Word 2000 you may need to comment the 2
'lines above and uncomment the 2 below.
' .RelativeHorizontalPosition = wdRelativeVerticalPositionPage
' .RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Left = wdShapeCenter
.Top = wdShapeCenter
End With
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.Collapse Direction:=wdCollapseEnd
Exit Sub
ErrHandler:
MsgBox "An error occured trying to insert the watermark." & Chr(13) & _
"Error Number: " & Err.Number & Chr(13) & _
"Decription: " & Err.Description, vbOKOnly + vbCritical, "Error"
End Sub
Sub RemoveWaterMark()
Dim strWMName As String
On Error GoTo ErrHandler
ActiveDocument.Sections(1).Range.Select
strWMName = ActiveDocument.Sections(1).Index
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes(strWMName).Select
Selection.Delete
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.Collapse Direction:=wdCollapseEnd
Exit Sub
ErrHandler:
'MsgBox "An error occured trying to remove the watermark." & Chr(13) & _
'"Error Number: " & Err.Number & Chr(13) & _
'"Decription: " & Err.Description, vbOKOnly + vbCritical, "Error"
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.Collapse Direction:=wdCollapseEnd
End Sub
I've created an AutoOpen macro which checks the first five characters of the document for "DRAFT", "Draft" or "draft" and then it should call the appropriate Subroutine:
Sub AutoOpen()
Dim oldfilename As String
Dim draft As String
oldfilename = ActiveDocument.Name
draft = Left(oldfilename, 5)
Select Case draft
Case "DRAFT", "Draft", "draft"
Call InsertWaterMark
Case Else
Call RemoveWaterMark
End Select
Exit Sub
BUT I'm getting an error when the code branches to the InsertWatermark Subroutine and the line
.Name = strWMName
I then get an error:
An error occurred trying to insert the watermark. Error Number: 70 Description: Permission denied
How can I fix the error?

Answer 1

You need to convert Integer which comes from .Sections(1).Index property into string. Two suggestions:
.Name = Cstr(strWMName)
or
.Name = "WaterMarkName" & strWMName
Please remember to change accordingly in RemoveWaterMark subroutine.