A family of Microsoft word processing software products for creating web, email, and print documents.
Edit Multiple Watermarks
Hello,
I am trying to find out how i can edit the watermarks on multiple word documents without having to manually open and edit each individual document.
I came across a macro that sort of worked, it added another watermark over the existing one and i had to go and manually remove watermarks and then re-add what i wanted. I will put the macro below, maybe someone with more knowledge than me can edit it or explain what i need to do with it.
So to explain exactly what i need; I make document packs for people, I have my master files which I copy and then paste into a folder for that client. I then have to go and add in the clients logo, names, dates and so on, I also have to change the watermark on 40-50 word documents which takes forever.
I would like to have a macro or something where i can enter in what i want to be displayed as the watermark
Select the folder containing all the documents i want to have changed and then let it do it's thing.
Can anyone please help me with this one?
Thanks.
Option Explicit
Sub BatchProcess()
Dim strFileName As String
Dim strPath As String
Dim oDoc As Document
Dim oLog As Document
Dim oRng As Range
Dim oHeader As HeaderFooter
Dim oSection As Section
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , _
"List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "" _
Then strPath = strPath + ""
End With
If Documents.Count > 0 Then
Documents.Close savechanges:=wdPromptToSaveChanges
End If
Set oLog = Documents.Add
If Left(strPath, 1) = Chr(34) Then
strPath = Mid(strPath, 2, Len(strPath) - 2)
End If
strFileName = Dir$(strPath & "*.doc?")
While Len(strFileName) <> 0
WordBasic.DisableAutoMacros 1
Set oDoc = Documents.Open(strPath & strFileName)
'
'Do what you want with oDoc here
For Each oSection In oDoc.Sections
For Each oHeader In oSection.Headers
If oHeader.Exists Then
Set oRng = oHeader.Range
oRng.Collapse wdCollapseStart
InsertMyBuildingBlock "CONFIDENTIAL 1", oRng
End If
Next oHeader
Next oSection
'record the name of the document processed
oLog.Range.InsertAfter oDoc.FullName & vbCr
'
oDoc.Close savechanges:=wdSaveChanges
WordBasic.DisableAutoMacros 0
strFileName = Dir$()
Wend
End Sub
Function InsertMyBuildingBlock(BuildingBlockName As String, HeaderRange As Range)
Dim oTemplate As Template
Dim oAddin As AddIn
Dim bFound As Boolean
Dim i As Long
bFound = False
Templates.LoadBuildingBlocks
For Each oTemplate In Templates
If InStr(1, oTemplate.Name, "Building Blocks") > 0 Then Exit For
Next
For i = 1 To Templates(oTemplate.FullName).BuildingBlockEntries.Count
If Templates(oTemplate.FullName).BuildingBlockEntries(i).Name = BuildingBlockName Then
Templates(oTemplate.FullName).BuildingBlockEntries(BuildingBlockName).Insert _
Where:=HeaderRange, RichText:=True
'set the found flag to true
bFound = True
'Clean up and stop looking
Set oTemplate = Nothing
Exit Function
End If
Next i
If bFound = False Then 'so tell the user.
MsgBox "Entry not found", vbInformation, "Building Block " _
& Chr(145) & BuildingBlockName & Chr(146)
End If
End Function
Microsoft 365 and Office | Word | For business | Windows
Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.