Header_Footer

[Bikram]

Hi, there


I have been trying to insert the header through vba but got no luck. I tried to do so using building blocks. The macro similar to this macro has worked previously on my previous computer. but now when I tried to insert building blocks but it said "The requested collection does not exist". Here is the code i used

Sub Hederfooter()

Dim ad As Document
Dim H_O As BuildingBlock
Dim H_E As BuildingBlock


Set ad = ActiveDocument
Set H_O = ad.AttachedTemplate.BuildingBlockEntries("H_odd")
Set H_E = ad.AttachedTemplate.BuildingBlockEntries("H_even")

With ad.Sections(1)
.Headers(wdHeaderFooterEvenPages).Range.Text = H_O
.Headers(wdHeaderFooterPrimary).Range.Text = H_O
End With



End Sub


Can anybody help me on how i can insert header through building blocks. I have the code provided by gmayor to insert building blocks



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(strBuildingBlockNam e).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(strBuildingBlockNam e).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(strBuildingBlo ckName).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

Can these two macros be merged together to produce the desired result?? Thanks in advance.