none
VBA adding custom watermark to all files in folder RRS feed

  • Question

  • So I have grabbed this bit of VBA code from this post:

    http://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_other/how-to-add-watermark-for-multiple-files/481d7483-f731-4971-91fe-8e48cb3b8b2a

    and it works perfectly for exactly what I want to do, except I want to use a custom watermark instead of a built in one.

    My watermark is called WATER instead of CONFIDENTIAL 1.

    So I created a new building block called Water and it works when applying it just like the Confidential 1 watermark does but when I change the code to be WATER instead of CONFIDENTIAL 1 and run the macro it doesn't find the watermark. If I change the code back to CONFIDENTIAL 1 it works.

    Any help?

    Sub PrintFormWithWMark()
    Dim oDoc As Document
    Dim oSection As Section
    Dim oHeader As HeaderFooter
    Dim oRng As Range
    Dim strName As String
    Dim strBBPath As String
    Dim bProtected As Boolean
    Const strPassword As String = "" 'Password to unlock protected form
    Const strBBName As String = "CONFIDENTIAL 1" 'The building block name that you want to insert

    strBBPath = "C:\Users\" & (Environ$("Username")) & "\AppData\Roaming\Microsoft\Document Building Blocks\1033\14\Built-In Building Blocks.dotx"

    Set oDoc = ActiveDocument
    oDoc.Save 'save the document
    strName = oDoc.FullName 'Record the document name

    'Unprotect the file if protected
    If ActiveDocument.ProtectionType <> wdNoProtection Then
        bProtected = True
        ActiveDocument.Unprotect Password:=strPassword
    End If

    'Address each section
    For Each oSection In oDoc.Sections
        'Address each header in the section
        For Each oHeader In oSection.Headers
            Set oRng = oHeader.Range
            oRng.Start = oRng.End 'set the range to the end of the header
            'Insert the built-in building block
            Application.Templates(strBBPath).BuildingBlockEntries(strBBName).Insert Where:=oRng, RichText:=True
        Next oHeader
    Next oSection

    'If thedocument  was protected - reprotect it
    If bProtected = True Then
        ActiveDocument.Protect _
        Type:=wdAllowOnlyFormFields, _
        NoReset:=True, _
        Password:=strPassword
    End If

    oDoc.PrintOut 'Print to the current printer
    oDoc.Close wdDoNotSaveChanges 'Close without saving the watermark
    Documents.Open strName 'Reopen the document without the watermark
    MsgBox "Document sent to printer." 'optional
    End Sub

    Tuesday, September 27, 2016 12:50 AM

Answers

  • Hi wnanthony,

    According to your description, I have made a sample and reproduced this issue.

    Create and save Custom Watermark, then Insert->Quick Parts->Building Blocks Organizer...


    Set oDoc = Application.Documents.Open("D:\InsertWatermark.docx")
    For Each oSection In oDoc.Sections
         'Address each header in the section
         For Each oHeader In oSection.Headers
             Set oRng = oHeader.Range
             oRng.Start = oRng.End 'set the range to the end of the header
             'Insert the built-in building block
             Application.Templates( _
         "C:\Users\v-jundai\AppData\Roaming\Microsoft\Document Building Blocks\1033\16\Building Blocks.dotx" _
         ).BuildingBlockEntries("Water").Insert Where:=oRng, RichText:= _
         True
    
         Next oHeader
    Next oSection
    
    oDoc.Close wdSaveChanges  'Close without saving the watermark
    Application.Documents.Open "D:\InsertWatermark.docx"

    Get the right result:

    So I suggest that you could modify your code like below:

    'strBBPath = "C:\Users\" & (Environ$("Username")) & "\AppData\Roaming\Microsoft\Document Building Blocks\1033\14\Built-In Building Blocks.dotx"
    strBBPath = "C:\Users\" & (Environ$("Username")) & "\AppData\Roaming\Microsoft\Document Building Blocks\1033\14\Building Blocks.dotx"


    Thanks for your understanding.

             
    • Edited by David_JunFeng Thursday, September 29, 2016 5:55 AM
    • Proposed as answer by David_JunFeng Wednesday, October 5, 2016 1:37 PM
    • Marked as answer by David_JunFeng Wednesday, October 5, 2016 1:37 PM
    Thursday, September 29, 2016 5:52 AM

All replies

  • Hi,

    Since your question is more related to development, I'm moving it to the dedicated Word for developer forum, there you should get more professional responses:

    https://social.msdn.microsoft.com/Forums/office/en-US/home?forum=worddev

    Regards,

    Ethan Hua


    Please remember to mark the replies as answers if they help and unmark them if they provide no help.
    If you have feedback for TechNet Subscriber Support, contact tnmff@microsoft.com.

    Wednesday, September 28, 2016 8:06 AM
  • Hi wnanthony,

    According to your description, I have made a sample and reproduced this issue.

    Create and save Custom Watermark, then Insert->Quick Parts->Building Blocks Organizer...


    Set oDoc = Application.Documents.Open("D:\InsertWatermark.docx")
    For Each oSection In oDoc.Sections
         'Address each header in the section
         For Each oHeader In oSection.Headers
             Set oRng = oHeader.Range
             oRng.Start = oRng.End 'set the range to the end of the header
             'Insert the built-in building block
             Application.Templates( _
         "C:\Users\v-jundai\AppData\Roaming\Microsoft\Document Building Blocks\1033\16\Building Blocks.dotx" _
         ).BuildingBlockEntries("Water").Insert Where:=oRng, RichText:= _
         True
    
         Next oHeader
    Next oSection
    
    oDoc.Close wdSaveChanges  'Close without saving the watermark
    Application.Documents.Open "D:\InsertWatermark.docx"

    Get the right result:

    So I suggest that you could modify your code like below:

    'strBBPath = "C:\Users\" & (Environ$("Username")) & "\AppData\Roaming\Microsoft\Document Building Blocks\1033\14\Built-In Building Blocks.dotx"
    strBBPath = "C:\Users\" & (Environ$("Username")) & "\AppData\Roaming\Microsoft\Document Building Blocks\1033\14\Building Blocks.dotx"


    Thanks for your understanding.

             
    • Edited by David_JunFeng Thursday, September 29, 2016 5:55 AM
    • Proposed as answer by David_JunFeng Wednesday, October 5, 2016 1:37 PM
    • Marked as answer by David_JunFeng Wednesday, October 5, 2016 1:37 PM
    Thursday, September 29, 2016 5:52 AM