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

Question

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
Header on all pages, footer in first page only that works if the header and footer are text only.
ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range = "Header_2"
ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text = "Main footer"
ActiveDocument.Sections(1).PageSetup.DifferentFirstPageHeaderFooter = True
ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Text = "First page header"
ActiveDocument.Sections(1).Footers(wdHeaderFooterFirstPage).Range.Text = "First page footer"
Is it possible to add to the text in quotes - sendkeys() to use the functionality of {f3} that populates the header from quick parts?

Answer 1

Create a range variable, set it to the particular header or footer you want, then replace Selection.Range with that variable. To set a range variable:
Dim myRange as Range
Set myRange = ActiveDocument.Sections(1).Footers(wdHeaderFooterFirstPage).Range
The macro recorder tells me:
Application.Templates( _
"C:\Users\jkorc\AppData\Roaming\Microsoft\Templates\Normal.dotm"). _
BuildingBlockEntries("I have a macro").Insert Where:=Selection.Range, _
RichText:=True
Replace Selection.Range with myRange.
If the QuickPart is AutoText in the template attached to the document, you can use:
ActiveDocument.AttachedTemplate.AutoTextEntries("I have a macro").Insert myRange

Answer 2

From my page on using vba to insert building blocks:
You need to, somehow, identify the building block:
Template
Gallery
Category, and
Name
Recording a macro will work, to a limited extent. Recorded macros
will not work on someone else's system even if they have the same
building blocks or even if they are a different user on the same
computer. Recorded macros will not work if the template contains more
than one building block with the same name, even if they are different
types. Note that the file that comes with Word "Built-In Building
Blocks.dotx" has many building blocks with the same names. You can use
the Building Blocks Organizer and sort by name to see if there are
multiple building blocks with the same name and in the same template.
Because of these limitations, often you will need to actually write a
macro.
However, you can try recording one. The key is to use the Building
Blocks Organizer to insert the Building Block when recording the
macro, rather than a shortcut or another gallery/menu.
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