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.
Change Word headers
-
- SilverLounger
- Posts: 2347
- Joined: 23 Feb 2010, 12:07
Change Word headers
Best Regards,
Adam
Adam
-
- Administrator
- Posts: 78534
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Change Word headers
Do these documents have multiple sections, or just a single section?
Best wishes,
Hans
Hans
-
- Administrator
- Posts: 78534
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Change Word headers
Try this macro. It will let you select the folder to use.
Test on a copy of the folder first.
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
Hans
-
- SilverLounger
- Posts: 2347
- Joined: 23 Feb 2010, 12:07