Issue using Excel VBA to add Watermark to Word Document using BuildingBlockEntry

Question

I am currently trying to use Excel VBA to add a watermark to a Word document. I have been able to do so from Word VBA and have translated the code over to excel to implement other functions, and am getting an error on a specific line. I believe I need to better point to the Word building block when requesting the insert of the watermark, but am unsure.

The error is "The requested member of the collection does not exist" from the line: oWord.Templates(strBBPath).BuildingBlockEntries(strBBName).Insert Where:=oRng, RichText:=True

Here is my code:

    Sub AddWatermark()
     Dim oWord as Word.Application
     Dim oDoc As Word.Document
     Dim oSection As Word.section
     Dim oHeader As Word.HeaderFooter
     Dim oRng As Word.Range
     Dim strName As String
     Dim strPath As String
     Dim strBBPath As String
     Const strBBName As String = "SAMPLE 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"

               Dim lngCount As Long

               ' Open the file dialog
               With Application.FileDialog(msoFileDialogOpen)
                   .AllowMultiSelect = True
                   .Show

                   ' Display paths of each file selected
                   For lngCount = 1 To .SelectedItems.Count
                        Set oWord = New Word.Application
                        strPath = .SelectedItems(lngCount)
                        Set oDoc = oWord.Documents.Open(strPath)
                   Next lngCount
               End With

     'oDoc.Save 'save the document
     strName = oDoc.FullName 'Record the document name
     oWord.Visible = True

     '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
             oWord.Templates(strBBPath).BuildingBlockEntries(strBBName).Insert Where:=oRng, RichText:=True

         Next oHeader
     Next oSection

     End Sub

Answer 1

I found an answer for this one from this post - https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_other/run-time-error-5941-not-always-but-annoyingly/b95ec1db-6928-4d87-b799-52d4f1c01f08

The Word building blocks need to be loaded to pull from using this method: oWord.Templates.LoadBuildingBlocks

Thank you to everyone who took a look. :)

Answer 2

No clue why you get that specific error message unless you have a stray Word identifier somewhere else in your code. If you're running this in Excel, it should be "Run-time error 424 - Object required". You don't have access to the global Word object in Excel, so in this line...

Word.Application.Templates(strBBPath).BuildingBlockEntries(strBBName).Insert Where:=oRng, RichText:=True

...Excel has no idea what Word is. Option Explicit at the top of your module would have caught this error. You need to use your Word.Application object:

oWord.Templates(strBBPath).BuildingBlockEntries(strBBName).Insert Where:=oRng, RichText:=True

That said, you're obviously using early binding, so declare oWord as Word.Application...

Dim oWord As Word.Application

...and use New instead of CreateObject:

Set oWord = New Word.Application