How to insert Header from blocks saved in Quick Parts using macros?-CodePudding

I haven't understood how to use the object structure in the VBA. I barely get by picking up pieces from stack overflow to accomplish my task. Thanks a lot for everyone who contributes here.

I need to set the header in a document from Quick Parts. I found this Any macro, recorded or written, should be stored in the same template that holds the building block. That way, if the macro is available, the building block is available.

Writing a Macro

To do this, you need to know:

The name of the building block. If you have a unique name for the building block (no other building block of the same name exists in any building block entry location) then use Graham Mayor's macro found on one of his sample macro pages. A variation is shown below. The name (and location) of the template that holds the building block unless the macro is in the same template How to insert a macro. See Installing Macros and Install/Employ VBA Procedures (Macros).
Building Block Name = "MyBB" (example in this macro, change to fit)
Situation 1 and 1a have the Building Block and the macro in the same template. This simplifies coding because a macro can always tell the name and location of the template that holds it. That information is required to use a macro to insert a building block.

Situation 1 - template holds both the building block and the macro

Here is the macro to insert that uniquely-named building block at the insertion point in the document:

Sub InsertMyBB()
'  Will not work if there are multiple building blocks with the same name in the template! See below.
'
  Const sBBName As String = "MyBB" 'use the name of your building block instead of "MyBB"
'
  On Error GoTo Oops
  Application.Templates.LoadBuildingBlocks ' Thank you Timothy Rylatt
  Application.Templates(ThisDocument.fullname).BuildingBlockEntries(sBBName).Insert Where:=Selection.range, _
    RichText:=True ' Insert MyBB Building Block
  Exit Sub ' We're done here
Oops: ' Didn't work - building block not there!
  MsgBox Prompt:="The Building Block " & sBBName & " cannot be found in " & _
  ThisDocument.Name & ".", Title:="Didn't Work!"
  On Error GoTo -1
End Sub

This and the following macro are both contained in a demonstration template that can be downloaded from my downloads page.

Situation 1a - template holding building blocks and macro in same template - multiple building blocks with the same name

In this situation, the previous macro would confuse Word and give unpredictable (to the user) results. In this case, the macro needs to know both the gallery and category of the building block. The following macro assumes that the building block is stored in the AutoText gallery and in the General category. You can find the name of the gallery and category using the Building Blocks Organizer. Category names are plain text. Galleries are referenced in vba as Building Block Types and use constants. You can find a list of the constants for the different galleries here.

Sub InsertMyBB()
'
' Assumes that the Building Block is of the type AutoText (wdTypeAutoText) in Category "General"
' See https://msdn.microsoft.com/en-us/library/bb243303(v=office.12).aspx
'
' This is based in part upon contributions from Greg Maxey and Jay Freedman - any errors remain mine
' Written by Charles Kenyon April 2021
'
  Const sBBName As String = "MyBB" 'use the name of your building block instead of "MyBB"
  Const sTempName As String = ThisDocument.fullname ' puts name and full path of template in string
'
  Dim oBB As BuildingBlock
'
  On Error Resume Next
  Application.Templates.LoadBuildingBlocks ' Thank you Timothy Rylatt
  Set oBB = Application.Templates(sTempName).BuildingBlockTypes(wdTypeAutoText) _
     .Categories("General").BuildingBlocks(sBBName)
  If err.Number = 0 Then
    oBB.Insert Selection.range, True
  Else
    MsgBox Prompt:="The Building Block '" & sBBName & "' cannot be found in " & _
       ThisDocument.Name & ".", Title:="Didn't Work!"
  End If
lbl_Exit:
  On Error GoTo -1
  Set oBB = Nothing
End Sub

This and the preceding macro are both contained in a demonstration template that can be downloaded from my downloads page.

Situation 2 - template holding building block is in Word Startup Folder and named MyBBTemplate.dotx

This template, for some reason, does not hold the macro, it is in a separate template. We know the name of the container template. The name of the template containing the macro does not matter for our purposes.

Sub InsertMyBB()
'  Will not work if the Startup Folder is the root directory of a drive, i.e. C:\
'  For use with building block stored in a template loaded in the Word Startup Folder that does NOT hold this macro
'  Will not work if there are multiple building blocks with the same name in the template!
'
  Const sBBName As String = "MyBB" 'use the name of your building block instead of "MyBB"
  Const sTempName As String = "MyBBTemplate.dotx" 'use the name of your template instead of "MyBBTemplate.dotx"
  On Error GoTo NoStartupPath
  Const sStartupFolder As String = Application.Options.DefaultFilePath(wdStartupPath)
'
  On Error GoTo Oops ' error handler
  Application.Templates.LoadBuildingBlocks ' Thank you Timothy Rylatt
  Application.Templates(sStartupPath & "\" & sTemplateName).BuildingBlockEntries(sBBName) _
     .Insert Where:=Selection.range, RichText:=True ' Insert MyBB Building Block
  Exit Sub ' We're done here
NoStartupPath:
  On Error GoTo -1
  MsgBox Prompt:="No Startup Folder Set in Options"
  Exit Sub
Oops: ' Didn't work - building block not there!
  MsgBox Prompt:="The Building Block " & sBBName & " cannot be found in " & _
  sTemplateName & ".", Title:="Didn't Work!"
  On Error GoTo -1
End Sub

Situation 3 - Insert a building block with a unique name at a bookmark, regardless of location

This macro does NOT care where the building block is stored but its name must be unique to have predictable results.

Sub InsertMyBuildingBlock_Bookmark()
' Charles Kenyon 09 April 2021
' based on Graham Mayor's macro at
' http://www.gmayor.com/word_vba_examples_3.htm
' In addition to checking the active template, add-in templates and the normal template,
' this macro looks in the building blocks.dotx template.
' Building Block name must be unique!
'
  Const BookMarkNAME As String = "delete" ' use the name of the building block - make variable if multiple bookmarks
'
  Dim oTemplate As Template
  Dim oAddin As AddIn
  Dim bFound As Boolean
  Dim oRng As range
  Dim i As Long
  'Define the required building block entry
  Const strBuildingBlockName As String = "Building Block Name"
  ' Set the range
  Set oRng = ActiveDocument.Bookmarks(BookMarkNAME).range
  'Set the found flag default to False
  bFound = False
  'Ignore the attached template for now if the
  'document is based on the normal template
   Application.Templates.LoadBuildingBlocks ' Thank you Timothy Rylatt
   If ActiveDocument.AttachedTemplate <> NormalTemplate Then
    Set oTemplate = ActiveDocument.AttachedTemplate
    'Check each building block entry in the attached template
    For i = 1 To oTemplate.BuildingBlockEntries.Count
     'Look for the building block name
       'and if found, insert it.
      If oTemplate.BuildingBlockEntries(i).Name = strBuildingBlockName Then
        oTemplate.BuildingBlockEntries(strBuildingBlockName).Insert _
          Where:=oRng
        'Set the found flag to true
        bFound = True
        'Clean up and stop looking
        GoTo lbl_Exit
      End If
      Next i
  End If
  'The entry has not been found
  If bFound = False Then
    For Each oAddin In AddIns
      'Check currently loaded add-ins
      If oAddin.Installed = False Then Exit For
        Set oTemplate = Templates(oAddin.Path & _
          Application.PathSeparator & oAddin.Name)
        'Check each building block entry in the each add in
        For i = 1 To oTemplate.BuildingBlockEntries.Count
          If oTemplate.BuildingBlockEntries(i).Name = strBuildingBlockName Then
            'Look for the building block name
              'and if found, insert it.
            oTemplate.BuildingBlockEntries(strBuildingBlockName).Insert _
               Where:=oRng
            'Set the found flag to true
            bFound = True
            'Clean up and stop looking
            GoTo lbl_Exit
          End If
        Next i
    Next oAddin
  End If
  'The entry has not been found. Check the normal template
  If bFound = False Then
    For i = 1 To NormalTemplate.BuildingBlockEntries.Count
      If NormalTemplate.BuildingBlockEntries(i).Name = strBuildingBlockName Then
        NormalTemplate.BuildingBlockEntries(strBuildingBlockName).Insert _
          Where:=oRng
        'set the found flag to true
        bFound = True
      End If
    Next i
  End If
  'If the entry has still not been found
  'finally check the Building Blocks.dotx template
  If bFound = False Then
    Templates.LoadBuildingBlocks
    For Each oTemplate In Templates
      If oTemplate.Name = "Building Blocks.dotx" Then Exit For
    Next oTemplate
    For i = 1 To Templates(oTemplate.fullname).BuildingBlockEntries.Count
      If Templates(oTemplate.fullname).BuildingBlockEntries(i).Name = strBuildingBlockName Then
        Templates(oTemplate.fullname).BuildingBlockEntries(strBuildingBlockName).Insert _
          Where:=oRng
        'set the found flag to true
        bFound = True
       'Clean up and stop looking
        GoTo lbl_Exit
      End If
    Next i
  End If
  'All sources have been checked and the entry is still not found
  If bFound = False Then
    'so tell the user.
  MsgBox "Entry not found", _
    vbInformation, _
    "Building Block " _
    & Chr(145) & strBuildingBlockName & Chr(146)
  End If
lbl_Exit:
  set oTemplate = Nothing
  set oRng = Nothing
End Sub

For more thoughts/ideas on inserting a building block at a bookmark, see this thread: Updating bookmark with multiple building blocks based on checkbox