From my web site, the following code can be used to insert a named building block.
Code:
Option Explicit
'Graham Mayor - https://www.gmayor.com - Last updated - 01 Sep 2021
Sub InsertMyBuildingBlock()
Dim oTemplate As Template
Dim oAddin As AddIn
Dim bFound As Boolean
Dim i As Long
'Define the required building block entry
Const strBuildingBlockName As String = "Building Block Name"
'Set the found flag default to False
bFound = False
'Ignore the attached template for now if the
'document is based on the normal template
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:=Selection.Range
'Set the found flag to true
bFound = True
'Clean up and stop looking
Set oTemplate = Nothing
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:=Selection.Range
'Set the found flag to true
bFound = True
'Clean up and stop looking
Set oTemplate = Nothing
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:=Selection.Range
'set the found flag to true
bFound = True
GoTo lbl_Exit
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
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:=Selection.Range
'set the found flag to true
bFound = True
'Clean up and stop looking
Set oTemplate = Nothing
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 oAddin = Nothing
Exit Sub
End Sub