Inserting headers to all pages VBA word2007

[Ray.Mason]

Hi Guys,

Just joined this forum.:hi:

I'm copying multiple word documents from one folder, make a few changes and save them in a different folder.
I'm having problems when it comes to inserting a header to ALL header sections. The code below only applies the header to last page. I would ideally want this code to open all header sections and insert a customised
header stored in my building blocks.dotx.

This is my current code:

Dim oHF As HeaderFooter
Dim oSection As Section

For Each oSection In ActiveDocument.Sections
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
For Each oHF In oSection.Footers

Templates.LoadBuildingBlocks
For Each Template In Templates
If Template.Name = "Building Blocks.dotx" Then


Templates(Template.FullName). _
BuildingBlockEntries("my.logo"). _
Insert Where:=Selection.Range, RichText:=True



End If
Next
Next
Next

Many thanks in advance,

[macropod]

Hi Ray,

Try something along the lines of:
Sub Demo()
Dim Tmplt As Template, Logo, Sctn As Section, HdFt As HeaderFooter
Templates.LoadBuildingBlocks
For Each Tmplt In Templates
If Tmplt.Name = "Building Blocks.dotx" Then
On Error Resume Next
Set Logo = Tmplt.BuildingBlockEntries("my.logo")
Exit For
End If
Next
If Logo Is Nothing Then Exit Sub
With ActiveDocument
For Each Sctn In .Sections
For Each HdFt In Sctn.Footers
If HdFt.LinkToPrevious = False Then HdFt.Range.InsertAfter Logo
Next
Next
End With
Set Logo = Nothing
End Sub

[Ray.Mason]

You're a genious!. Been browsing web and posting to forums for past days with no luck, but your code seems to do the trick. I've used it and it inserts a star character (*) character in the header. If I choose one of the text based word headers it inserts in header sections just fine. I think there's something about my custom header that the macro doesn't like. It is an image banner header perhaps that's why. If I manually insert header it works, so I can't figure out why it doesn't insert when macro is run.

Many thanks for your help.

[macropod]

Hi ray,

I don't normally work with Building Blocks, so I'm having to work this out as I go. Try something along the lines of:
Sub Demo()
Dim Tmplt As Template, i As Long, Sctn As Section, HdFt As HeaderFooter
Templates.LoadBuildingBlocks
For Each Tmplt In Templates
If Tmplt.Name = "Built-In Building Blocks.dotx" Then
For i = 1 To Tmplt.BuildingBlockEntries.Count
With Tmplt.BuildingBlockEntries(i)
If .Type.Name = "Footers" Then
If .Name = "Mod (Odd Page)" Then
With ActiveDocument
For Each Sctn In .Sections
For Each HdFt In Sctn.Footers
If HdFt.LinkToPrevious = False Then Tmplt.BuildingBlockEntries(i).Insert HdFt.Range
Next HdFt
Next Sctn
End With
Exit For
End If
End If
End With
Next i
End If
Next Tmplt
End Sub
Note: The above code works, but it's wriiten to reference the "Built-In Building Blocks.dotx" file, whereas you're working with the "Building Blocks.dotx" file and, from that file, looks in the "Footers" gallery for one named "Mod (Odd Page)". I have no idea what gallery, if any, you're using and, obviously, you'll need to change the various names.

[Ray.Mason]

Again, Many thanks! I'll try this and will update you on progress. Logically it should definitely work but you can never tell with macros.

[Ray.Mason]

Hey Paul,

After a minimal tweak to above code, It finally worked. I made the footer sit in the quick parts instead as for some reason it failed to go past If.Name = "Footers" Then line. Also moaned about i which I changed to counter, Other than that no major changes.

If .Type.Name = "Quick Parts" Then
If .Name = "Mod (Odd Page)" Then
With ActiveDocument

Really appreciate all time and effort you've put in writing/submitting code to help me out. I have been pulling my hair out for the past weeks.

Many thanks!