Change Word headers

User avatar
adam
SilverLounger
Posts: 2347
Joined: 23 Feb 2010, 12:07

Change Word headers

Post by adam »

Hi anyone,

How could I change the headers of multiple Microsoft Word 2007 documents in a certain folder.

Any help on this would be kindly appreciated.

Thanks in advance.
Best Regards,
Adam

User avatar
HansV
Administrator
Posts: 78489
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Change Word headers

Post by HansV »

Do these documents have multiple sections, or just a single section?
Best wishes,
Hans

User avatar
HansV
Administrator
Posts: 78489
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Change Word headers

Post by HansV »

Try this macro. It will let you select the folder to use.

Test on a copy of the folder first.

Code: Select all

Sub ChangeHeaders()
  Dim strPath As String
  Dim strFile As String
  Dim doc As Document
  Dim sec As Section
  Dim hdr As HeaderFooter

  On Error GoTo ErrHandler

  ' Prompt the user to select a folder
  With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = False Then
      MsgBox "You didn't select a folder.", vbExclamation
      Exit Sub
    End If
    strPath = .SelectedItems(1)
  End With
  If Right(strPath, 1) <> "\" Then
    strPath = strPath & "\"
  End If

  Application.ScreenUpdating = False

  ' Loop through the Word documents in the folder
  strFile = Dir(strPath & "*.doc*")
  Do While strFile <> ""
    Set doc = Documents.Open(strPath & strFile)
    ' Loop through the sections in the document
    For Each sec In doc.Sections
      ' Loop through the headers in the section
      For Each hdr In sec.Headers
        ' Check whether the header has been defined
        If hdr.Exists Then
          ' Skip headers that are the same as that of the previous section
          If sec.Index = 1 Or hdr.LinkToPrevious = False Then
            ' Set the text of the header - modify as needed
            hdr.Range.Text = vbTab & "Adam's Document Header"
          End If
        End If
      Next hdr
    Next sec
    doc.Close SaveChanges:=True
    strFile = Dir
  Loop

ExitHandler:
  Application.ScreenUpdating = True
  Exit Sub

ErrHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitHandler
End Sub
Best wishes,
Hans

User avatar
adam
SilverLounger
Posts: 2347
Joined: 23 Feb 2010, 12:07

Re: Change Word headers

Post by adam »

Thanks for the help Hans. I do really appreciate it.
Best Regards,
Adam