Insert Autotext Entry with VBA - Word 2007/2010

Word 2007 introduced building blocks which added a whole lot of other parameters and a separate building blocks template where autotext entries could be stored. Provided the autotext entry that you wish to insert is defined in the autotext gallery (or it is included in a Word 97-2003 format template or add-in, then the above macro will work as it stands. If you want to check all the galleries, then you will need some extra code. In addition to checking the active template, add-in templates and the normal template, the following finally looks in the building blocks.dotx template.

It is to be hoped that if you are using vba to insert entries, you might have a better idea of where they are stored beforehand, but this macro should do the trick wherever they are.

Sub InsertMyBuildingBlock()
Dim strText As String
Dim oTemplate As Template
Dim oAddin As AddIn
Dim bFound As Boolean
Dim i As Long

'Define the required building block entry
strText = "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 = strText Then
               oTemplate.BuildingBlockEntries(strText).Insert _
                 Where:=Selection.Range
               'Set the found flag to true
               bFound = True
               'Clean up and stop looking
               Set oTemplate = Nothing
               Exit Sub
          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 = strText Then
                    'Look for the building block name
                    'and if found, insert it.
                    oTemplate.BuildingBlockEntries(strText).Insert _
                      Where:=Selection.Range
                    'Set the found flag to true
                    bFound = True
                    'Clean up and stop looking
                    Set oTemplate = Nothing
                    Exit Sub
               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 = strText Then
               NormalTemplate.BuildingBlockEntries(strText).Insert _
                 Where:=Selection.Range
               'set the found flag to true
               bFound = True
               Exit Sub
          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 = strText Then
               Templates(oTemplate.FullName).BuildingBlockEntries(strText).Insert _
                 Where:=Selection.Range
               'set the found flag to true
               bFound = True
               'Clean up and stop looking
               Set oTemplate = Nothing
               Exit Sub
          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) & strText & Chr(146)
End If
End Sub