Document Header and Footer images placed in exact locations in bulk

[OpPot]

Hi guys,

I'm currently changing the logos in bulk for 1000s of documents and know there to be an easier way to do this.

I have some template documents which contain the right header and footer placements for each of the images, but I, so far, have not been able to translate this into bulk header and footer image changes for multiple documents through VBA code (I lack suitable knowledge in this department)

What I currently have is the following:
Logo #1 and Logo #2 - One for a portrait layout, the other for a landscape layout respectively.
Footer #1 and Footer #2 - One for a portrait layout, the other for a landscape layout respectively.
Both should have Text Wrapping: Behind Text.

What I'd like:
I'd like to apply logo #1 and footer #1 for portrait with a specific position on the page (in headers and footers with the positions given below)
If the document is not portrait, I'd like for logo #2 and footer #2 for landscape to be used on a specific position on the page (in headers and footers with positions given below)
I would also like to be able to select the locations of these logos and footers or alternatively, just write their path so they can be imported from there and pasted in bulk

The exact location and s regarding where the logos should be in the header (depending on page layout portrait or landscape):

Landscape Logo:

Portrait Logo:

The exact locations regarding where the footer image should be in the footer (depending on page layout portrait or landscape)

Footer:
(The same position whether or not its landscape or portrait)

Any help would be appreciated. If there is a smarter way to do this without VBA code, please let me know!

 

[Macropod]

Create a single document with two Sections.
Unlink the headers & footers for the last Section from the first section.
Give the first Section a portrait layout and the header footer content for that layout.
Give the last Section a landscape layout and the header footer content for that layout.
Add the following macro to the document.
Run the macro and select the folder to process.

Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim DocSrc As Document, DocTgt As Document
Dim StrSrcNm As String, StrTgtNm As String
strFolder = GetFolder: If strFolder = "" Then Exit Sub
Set DocSrc = ActiveDocument: StrSrcNm = DocSrc.FullName
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  DocTgt = strFolder & "\" & strFile
  If StrSrcNm < DocTgt Then
    Set DocTgt = Documents.Open(FileName:=DocTgt, AddToRecentFiles:=False, Visible:=False)
    With DocTgt
      With .Sections.First
        Select Case .PageSetup.Orientation
          Case wdOrientLandscape
            Select Case .PageSetup.DifferentFirstPageHeaderFooter
              Case True
                With .Headers(wdHeaderFooterFirstPage).Range
                  .FormattedText = DocSrc.Sections.First.Headers(wdHeaderFooterPrimary).Range.FormattedText
                  .Characters.Last.Previous = vbNullString
                End With
                With .Footers(wdHeaderFooterFirstPage).Range
                  .FormattedText = DocSrc.Sections.First.Footers(wdHeaderFooterPrimary).Range.FormattedText
                  .Characters.Last.Previous = vbNullString
                End With
              Case False
                With .Headers(wdHeaderFooterPrimary).Range
                  .FormattedText = DocSrc.Sections.First.Headers(wdHeaderFooterPrimary).Range.FormattedText
                  .Characters.Last.Previous = vbNullString
                End With
                With .Footers(wdHeaderFooterPrimary).Range
                  .FormattedText = DocSrc.Sections.First.Footers(wdHeaderFooterPrimary).Range.FormattedText
                  .Characters.Last.Previous = vbNullString
                End With
            End Select
          Case wdOrientPortrait
            Select Case .PageSetup.DifferentFirstPageHeaderFooter
              Case True
                With .Headers(wdHeaderFooterFirstPage).Range
                  .FormattedText = DocSrc.Sections.Last.Headers(wdHeaderFooterPrimary).Range.FormattedText
                  .Characters.Last.Previous = vbNullString
                End With
                With .Footers(wdHeaderFooterFirstPage).Range
                  .FormattedText = DocSrc.Sections.Last.Footers(wdHeaderFooterPrimary).Range.FormattedText
                  .Characters.Last.Previous = vbNullString
                End With
              Case False
                With .Headers(wdHeaderFooterPrimary).Range
                  .FormattedText = DocSrc.Sections.Last.Headers(wdHeaderFooterPrimary).Range.FormattedText
                  .Characters.Last.Previous = vbNullString
                End With
                With .Footers(wdHeaderFooterPrimary).Range
                  .FormattedText = DocSrc.Sections.Last.Footers(wdHeaderFooterPrimary).Range.FormattedText
                  .Characters.Last.Previous = vbNullString
                End With
            End Select
        End Select
      End With
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Wend
Set DocSrc = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

For PC macro installation & usage instructions, see: Installing Macros

Note1: The macro replaces any existing header/footer content.

Note2: You should not update any documents that have already been sent to third parties. Doing so can have significant negative legal implications.