Share via

Edit Multiple Watermarks

Anonymous
2022-04-13T10:43:12+00:00

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.

0 comments No comments