I have been tasked with updating numerous MS Word doc and docx files. The existing document files have an OLE Object consisting of a linked Word document which allowed all the files to have the organization's letterhead appear on the first page. This system worked very well, since any changes to the source letterhead file would automatically update when the files were opened.

My client worked with a vendor to generate a new letterhead file as part of an organization relaunch. The new letterhead file now has a page 2 letterhead that needs appear on page 2 and all subsequent pages. Therefore, I can no longer just insert eh OLE Object into the body of the file, I now have to use the file header.

I have used code that others have shared here to piece together a process that cleans the existing files by removing any existing OLE Object shapes and any existing headers and then changes the page set up to have a different first page header. The routine then inserts the new page 1 letterhead doc into the 1st page header and moves it behind the text and then does the same for the page 2 header. I had to save and close the files to get this to work as desired, but it finally works.

My issue now is that many of these files have a section set up to also print an envelope. Unfortunately, now the envelopes also have the primary header associated with it, so the envelopes are printing with the header.

Does anyone know of a way to prevent the header from printing on the envelope? Anything I can find looks like it deletes the primary header, but that would delete it from all secondary pages, which I cannot do.

Here is my code:

Sub moveLetterheadToHeader()
'Created: 1/4/2025  By: Mike Devlin
'Need a routine to move the letterhead shape to the documents header
'First delete the shape, then re-add it to the document's header
'Then try and add the second page letterhead to the header for pages that are not the first page
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim oShape As Word.Shape
Dim oShape2 As Word.Shape
Dim oShape3 As Word.Shape
Dim strPathAndFile As String

strPathAndFile = ""
'    strPathAndFile = "C:\Users\mdevlin\Documents\LH\Appeal Letter_NoPage2.doc"
strPathAndFile = "C:\Users\mdevlin\Documents\LH\Appeal Letter_Pg2.doc"
'    strPathAndFile = "C:\Users\mdevlin\Documents\LH\Appeal Letter_Pg2Env.doc"

Set oWord = New Word.Application

'******************************

'Get rid of any OLE Object shapes
'open the file with Word
Set oDoc = oWord.Documents.Open(strPathAndFile)

'Find the shape and then delete it
For Each oShape In oDoc.Shapes
    If oShape.Type = msoLinkedOLEObject Then
        oShape.Delete
        Exit For
    End If
Next oShape

oDoc.Save

oDoc.Close False

'*************************

'Get rid of any existing headers or footers
'and set up the dioc file to have a different first page header
Set oDoc = oWord.Documents.Open(strPathAndFile)

'Make sure we are viewing the file in print mode
If oDoc.ActiveWindow.ActivePane.View.Type = wdNormalView Or oDoc.ActiveWindow.ActivePane.View.Type = wdOutlineView Then
    oDoc.ActiveWindow.ActivePane.View.Type = wdPrintView
End If

'When I checked the file, somehow the old letterhead file had been linked into the primary header
'So I need to make sure there is no header in the primary header before adding the new page2 header
Dim Sctn As Word.Section
Dim HdFt As Word.HeaderFooter

For Each Sctn In oDoc.Sections
  For Each HdFt In Sctn.Headers
    If HdFt.Exists Then
        HdFt.Range.Text = vbNullString
    End If
  Next
Next

oDoc.PageSetup.HeaderDistance = 0
oDoc.PageSetup.FooterDistance = 0
oDoc.PageSetup.OddAndEvenPagesHeaderFooter = False
'When set to false, there is only the primary header and footer
'    oDoc.PageSetup.DifferentFirstPageHeaderFooter = False
'When set to true, the primary header and footer are not available and the first page and primary header and footer are available
oDoc.PageSetup.DifferentFirstPageHeaderFooter = True

oDoc.Save

oDoc.Close False
 '***************************

'Set up the first page header
Set oDoc = oWord.Documents.Open(strPathAndFile)

oDoc.Sections(1).Headers(wdHeaderFooterFirstPage).Range.InlineShapes.AddOLEObject ClassType:="Word.Document.12", _
    FILENAME:="S:\apps\Templates\Letterhead_pg1.docx", _
    LinkToFile:=True, _
    DisplayAsIcon:=False
Set oShape2 = oDoc.Sections(1).Headers(wdHeaderFooterFirstPage).Range.InlineShapes(1).ConvertToShape

oShape2.Top = 0
oShape2.Left = 0

oShape2.WrapFormat.Type = wdWrapBehind

'Gonna try saving and closing the doc, then re-opening the doc and setting the primary header after the re-open since that seemed to work when I did it manually

'Close the header
If oDoc.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
    oDoc.ActiveWindow.Panes(2).Close
End If

oDoc.Save

oDoc.Close False



'****************************

'Set up the primary header which will be used for all subsequent pages/sections
Set oDoc = oWord.Documents.Open(strPathAndFile)

'Make sure we are viewing the file in print mode
If oDoc.ActiveWindow.ActivePane.View.Type = wdNormalView Or oDoc.ActiveWindow.ActivePane.View.Type = wdOutlineView Then
    oDoc.ActiveWindow.ActivePane.View.Type = wdPrintView
End If

oDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.InlineShapes.AddOLEObject ClassType:="Word.Document.12", _
    FILENAME:="S:\apps\Templates\Letterhead_pg2.docx", _
    LinkToFile:=True, _
    DisplayAsIcon:=False
Set oShape3 = oDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.InlineShapes(1).ConvertToShape

oShape3.Top = 0
oShape3.Left = 0

oShape3.WrapFormat.Type = wdWrapBehind

'Close the header
If oDoc.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
    oDoc.ActiveWindow.Panes(2).Close
End If

oDoc.Save

oDoc.Close False

'************************

Set oDoc = Nothing

Set oShape = Nothing
Set oShape2 = Nothing
Set oShape3 = Nothing

If IsAppRunning("Word.Application") = True Then
    'Kill Word
    oWord.Quit
End If

Set oWord = Nothing
End Sub